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FOREWORD 


"“''This  report  contains  documentation  for  a  FORTRAN  implementation  of  a 
relational  database  manager.  Because  the  code  is  written  in  a  high-level 
language,  it  is  basically  transportable  to  any  computer  with  FORTRAN 
capability  (minor  modification  may  be  required  for  compatabi llty  with  a  host 
computer's  operating  system  and  compiler).  The  work  was  required  by  U31  to 
support  computer  studies  requiring  the  extensive  use  of  minefield  planning 
codes .  _ _ 

This  work  has  been  supported  by  the  Mine  Improvement  Program  at  NSWC 
under  Project  S0267. 

Approved  by: 

\J)ul 

IRA  M.  BLATSTEIN,  Head 

Radiation  Division 


CONTENTS 


Page 

INTRODUCTION . 1 

DATA  CATEGORIES . 1 

CATEGORY  CREATION . 2 

CATEGORY  REQUESTS . 3 

EXAMPLE . 3 

RECONFIGURATION . 5 

APPLICATION  PROGRAMS . 6 

REFERENCES . 7 

APPENDIX  A  -  SUBROUTINE  DOCUMENTATION . A-l 

APPENDIX  B  -  FORTRAN  CODE  LISTING . B-l 

DISTRIBUTION . (1) 


TABLES 


Table  Page 

1  COURSES . 4 

2  FACULTY . 4 

3  ASSIGN . 5 

4  ASSIGN . 5 


NSWC  TR  85-56 


INTRODUCTION 


This  report  contains  instruction  and  documentation  for  an  interactive 
relational  database  manager  code  called  BOSS.  BTREE,  which  is  an 
implementation  of  a  B+  tree  and  is  documented  in  Winston,1  provides  the 
fundamental  data  structure  utilized  by  BOSS  for  rapidly  retrieving  data  record 
keys.  This  work  completes  the  effort  begun  with  BTREE  to  develop  a  user- 
friendly  code  to  manage  and  maintain  medium-sized  databases,  thereby  providing 
U31  with  the  capability  to  efficiently  ar  easily  perform  large-scale  computer 
studies  which  analyze  various  questions  related  to  minefield  planning. 

The  following  sections  constitute  a  manual  for  using  BOSS,  along  with  an 
illustrative  example;  Appendix  A  contains  documentation  of  the  subprograms  and 
Appendix  B  contains  a  complete  listing  of  the  code  itself.  The  code  is 
written  in  a  DEC  version  of  FORTRAN  77  for  a  VAX/VMS  system,  and  is  therefore 
essentially  transportable  to  any  computer  with  FORTRAN  capability.  (Minor 
modification  may  be  required  for  compatability  with  a  host  computer's 
operating  system  and  compiler.)  The  format  for  file  names  is  assumed  to  be 
(name). (ext),  where  (name)  consists  of  at  most  9  characters,  and  (ext)  is  an 
extender,  or  modifier,  of  at  most  3  characters. 

DATA  CATEGORIES 


BOSS  can  manage  several  logically  independent  collections  of  data, 
henceforth  called  categories.  A  data  record  in  a  category  consists  of  a 
number  of  fields,  each  of  which  is  described  by  a  set  of  parameters:  field 
name,  data  type,  field  length,  and  resource  category. 

1)  The  field  name  is  usually  chosen  to  be  a  generic  descriptor  of  the  data 

stored  in  the  field. 

2)  A  discussion  of  each  data  type  follows: 

(a)  "Character  data"  is  data  which  generally  consists  of  names  and 
descriptive  words,  but  can  also  be  a  string  of  numbers,  usually 
Interspersed  by  separators  for  parsing  and  conversion  into  actual 
numerical  value  by  an  application  program.  (This  is  a  convenient 
way  to  store  a  row  or  column  in  a  numerical  table.)  BOSS,  itself, 
never  ascribes  any  numerical  significance  to  such  data. 

(b)  "Numerical  data"  differs  from  character  data  in  that  the  user  may 
request  BOSS  to  compare  it  with  respect  to  its  numerical,  and  not 
lexacographical ,  value. 

(c)  The  function  ENDATE  converts  a  date  between  January  1,  1900  and 
December  31,  2075  Into  the  number  of  days  since  December  31,  1899. 
The  function  SYM  then  uses  ASCII  symbols  to  convert  this  integer 
into  a  2-byte  symbol.  (The  inverse  process  is  accomplished  by 
calling  VAL  and  DEDATE.)  Hence,  only  2  bytes  of  memory  are  required 
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to  store  such  a  date,  a  much  smaller  memory  requirement  than 
interpreting  the  date  as  character  data.  Moreover,  a  comparison 
between  different  dates  is  easily  accomplished  by  comparing  their 
associated  integer  values.  Character  data  provides  an  adequate  way 
of  storing  dates  outside  the  allowable  range. 

(d)  The  category  TABLE  is  a  special  category  created  by  BOSS  to  save 
mass  storage  memory  and  also  aid  in  reducing  keystroke  errors.  When 
a  field  has  a  limited  number  of  possible  values,  e.g.,  color,  job 
title,  etc.,  it  is  more  efficient  to  enter  each  of  the  possible 
values  once  as  data  in  TABLE,  and  instead  store  the  associated  TABLE 
record  number,  or  pointer,  in  the  corresponding  field  of  the  actual 
data  record.  As  previously  discussed  above  in  part  (c),  a  pointer 
requires  only  2  bytes  of  memory.  Thus,  records  in  TABLE  consist  of 
two  fields:  the  field  name,  and  the  field  value,  both  designated  to 
have  a  field  length  of  10  characters.  Also,  when  data  records  are 
added  to  the  current  category,  all  of  the  possible  values  of  any 
field  with  "table  data"  are  displayed  in  a  numbered  list  from  which 
the  user  makes  a  selection,  thereby  eliminating  the  burden  of 
entering  the  complete  data  value. 

(e)  "Duplicate  data"  is  somewhat  similar  to  table  data  in  that  pointers 
are  stored  rather  than  actual  data  values.  If  the  data  records  of 
different  categories  contain  a  common  field,  that  is,  a  field  with 
the  same  name  and  same  set  of  data  values,  it  may  be  possible  to 
avoid  a  complete  duplication  of  the  field  in  each  of  the 
categories.  If  the  field  in  question  is  the  key  for  some  category, 
then  pointers  can  be  stored  as  the  field  data  in  the  other 
categories  containing  the  field.  (See  the  next  section  for  an 
explanation  of  keys.)  It  is  important  to  stress  that  duplicate 
fields  in  different  categories  must  have  exactly  the  same  field 
name! 

3)  The  field  length  is  the  maximum  number  of  characters  required  by  any  of 
the  possible  field  data  values. 

4)  The  resource  category  is  the  name  of  the  category  containing  the  actual 
field  data  values  rather  than  any  associated  pointers. 

CATEGORY  CREATION 


In  order  to  create  a  category,  a  category  name,  a  category  password 
(optional),  the  number  of  fields  in  a  typical  category  data  record,  and  the 
number  of  the  key  field  all  must  be  supplied  by  the  user.  The  data  in  the  key 
field  Is  called  the  key  and  must  uniquely  identify  the  data  record.  These 
four  category  parameters  are  stored  in  the  file  CAT.DAR,  a  record  of  which 
uses  the  category  name  as  its  key;  CAT. KEY  is  the  associated  B+  tree.  In 
addition,  the  user  must  supply  the  field  parameters,  discussed  In  the  previous 
section,  which  describe  a  typical  category  data  record.  The  parameters  for 
the  n  th  field  are  contained  in  the  n  th  record  of  (name).LAR. 
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When  appropriate,  parameters  have  default  values  assigned  to  them  by  BOSS. 
For  example,  the  field  length  is  automatically  set  equal  to  2  when  the  data 
type  of  a  field  is  neither  character  nor  numerical.  All  information  which 
must  be  supplied  by  the  user  is  entered  in  response  to  a  series  of  prompts 
by  BOSS. 

The  entire  collection  of  data  record  keys  is  stored  in  the  B+  tree 
(name). KEY,  and  (name).DAR  contains  the  associated  category  data  records. 

The  specifications  of  the  implementation  of  BOSS  given  in  Appendix  B 

are: 


maximum  number  of  records  per  category  65,535 

maximum  number  of  fields  per  record  20 

maximum  number  of  characters  per  field  100 

maximum  number  of  characters  per  record  256 

maximum  number  of  categories  associated 

with  a  current  category  via  duplicate  data  7 

CATEGORY  REQUESTS 


Most  category  requests  are  self-explanatory,  such  as  adding,  getting, 
deleting,  or  modifying  a  category  data  record.  In  addition,  the  user  can 
change  the  category  password,  review  the  record  field  parameters,  inquire 
about  the  number  of  records  currently  in  a  category,  or  write  all  the  records 
in  a  category  to  an  output  file.  A  special  type  of  search,  called  a  "range 
query",  retrieves  all  the  records  in  a  category  which  satisfy  a  particular  set 
of  conditions.  The  user  selects  a  subset  of  all  the  record  fields,  and  for 
each  such  field,  specifies  a  range  of  values  within  which  data  in  that  field 
must  lie.  Since  BOSS  examines  every  record  in  a  category  to  execute  this 
request.  It  is  possible  for  this  procedure  to  consume  a  relatively  larger 
amount  of  time. 

EXAMPLE 


The  example  discussed  In  this  section  is  purely  hypothetical,  but  is 
useful  In  demonstrating  how  to  specify  the  parameters  needed  to  define 
categories.  The  more  fundamental  problem  of  identifying  which  collections  of 
data  are  appropriate  as  categories  is  not  addressed  in  this  report,  and 
therefore  the  reader  Is  urged  to  consult  Kent2  or  Neely  and  Steward'3  for  very 
readable  Introductions  to  the  important  concepts  of  logically  independent  data 
and  normal -forms.  A  more  theoretical  discussion  can  be  found  in  Stout  and 
Woodworth. 
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Table  1  is  a  list  of  all  the  courses  offered  by  a  small  mathematics 
department.  This  table  of  data  constitutes  the  category  "COURSES". 


TABLE  1.  COURSES 


Title 

Number 

Credits 

Calculus  I 

120 

4 

Calculus  II 

121 

4 

Linear  Algebra 

235 

3 

Probability 

250 

3 

Statistics 

251 

3 

Analysis 

310 

3 

The  second  field  serves  as  the  key  field,  and  is  admissable  as  the  key  because 
the  course  number  uniquely  identifies  all  the  data  in  the  row  (record) 
containing  it.  The  first  field,  "Title",  also  qualifies  as  a  key, 
but  is  not  as  convenient  for  defining  the  category  "ASSIGN",  below.  "Title" 
is  assumed  to  contain  character  data  with  a  field  length  of  15  characters, 
"Number"  has  numerical  data  with  a  field  length  of  3,  and  "Credits"  also  has 
numerical  data,  but  with  a  field  length  of  1.  The  data  type  of  "Number"  is 
chosen  to  be  numerical  to  give  the  user  the  ability  to  make  certain  types  of 
requests,  such  as  asking  for  a  list  of  all  200-level  courses.  This  can  be 
accomplished  by  a  range  query  on  field  2  with  an  inclusive  upper  bound  of  299 
and  an  inclusive  lower  bound  of  200. 

Table  2  is  a  faculty  list.  The  key  field,  "Name",  has  character  data 


TABLE  2.  FACULTY 


Name 


Rank 


Jones 

Smith 

Brown 

Thomas 

Johnson 


lecturer 

instructor 

instructor 

professor 

instructor 


with  a  field  length  of  10.  (Although  7  characters  are  sufficient  for  all 
current  faculty  names,  the  field  is  defined  to  be  a  bit  larger  to  allow  for 
possible  future  changes  in  faculty.)  Since  there  are  only  three  faculty 
ranks,  the  second  field,  "Rank",  is  assumed  to  contain  table  data.  The  three 
associated  records  in  "Table"  are  (rank, lecturer),  (rank, instructor),  and 
(rank, professor). 


Finally,  the  course  assignments  listed  in  Table  3  provide  the  data  for 
the  category  "ASSIGN".  Fields  1  and  3  are  copies  of  key  fields  in  other 
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TABLE  3.  ASSIGN 


Number 

Section 

Name 

120 

1 

Jones 

120 

2 

Johnson 

121 

1 

Jones 

121 

2 

Johnson 

235 

1 

Smith 

250 

1 

Brown 

251 

1 

Brown 

312 

1 

Thomas 

categories.  Consequently,  they  are  assumed  to  have  duplicate  type  data  which 
is  related  to  the  resource  categories  "Courses"  and  "Faculty";  the  data  type 
of  "Section"  is  numerical  with  a  field  length  of  1.  However,  no  single  field 
can  serve  as  the  key  field  because,  in  general,  no  row  is  uniquely  identified 
by  the  data  in  any  one  field.  The  data  in  field  1  together  with  the  data  in 
field  2  do  identify  rows,  and  thus,  an  additional  field  containing  "compound" 
data  is  added  to  the  category,  as  is  shown  in  Table  4. 


TABLE  4.  ASSIGN 


Key 

Number 

Section 

Name 

1201 

120 

1 

Jones 

1202 

120 

2 

Johnson 

1211 

121 

1 

Jones 

1212 

121 

2 

Johnson 

2351 

235 

1 

Smith 

2501 

250 

1 

Brown 

2511 

251 

1 

Brown 

3101 

310 

1 

Thomas 

The  new  field,  "Key",  is  an  artifice  which  provides  "ASSIGN"  with  a  key.  This 
device  is  not  uncommon  in  practice. 

RECONFIGURATION 

The  following  specifications  can  be  altered  easily  to  satisfy  special 
requirements  of  the  user: 

(a)  To  change  the  maximum  number  of  fields  per  record  to  f,  declare  the 
arrays  LONG (f ) ,  10(f),  TYPE(f),  FLD(f),  TITLE(f),  WHERE(f),  INA(f), 
INB(f),  EXA(f),  and  EXB(f)  in  COMMON/XXXBOSS/,  and  LINK(f)  and 
WIDTH (f)  in  SUBROUTINE  OUTPUT; 
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(b)  To  change  the  maximum  number  of  characters  per  field  to  c,  declare 
the  array  FLD(f)  as  CHARACTERS  (the  maximum  key  length  in  BTREE 
should  also  be  checked  to  make  sure  it  is  at  least  as  big  as  c); 

(c)  To  change  the  maximum  number  of  characters  per  record  to  r,  declare 
the  variable  RECDATA  as  CHARACTERS. 

APPLICATION  PROGRAMS 

In  order  for  an  application  program  to  retrieve  data  from  one  or  more 
categories,  the  user  need  only  check  the  source  code  of  BOSS  to  find  out  how 
to  access  a  category  and  its  data.  Usually,  this  requires  little  more  than 
adding  SUBROUTINE  OPENCAT  and  SUBROUTINE  RECOUT  to  the  application  program, 
and  writing  a  short  subroutine  to  get  the  appropriate  data.  Of  course,  the 
application  program  must  also  be  linked  with  BTREE  when  forming  the  executable 
image. 
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APPENDIX  A 

SUBROUTINE  DOCUMENTATION 
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SUBROUTINE  MODWORD 

PURPOSE:  To  modify  the  current  category  password. 

CHARACTER*9  name  of  the  current  category 

8TTE  parameter  set  equal  to  9 

CHARACTE'R*6  array  of  record  formats 

OUTPUTS: 

none 

EXTERNALS: 


INPUTS: 
CATNAME 
NINE 
HOW  (  ) 


BTREE 
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SUBROUTINE  MODREC 


PURPOSE: 

To  control  the 

logic  for  modifying  a  data  record. 

INPUTS: 

CATNAME 

CHARACTER*9 

name  of  the  current  category 

KEYFLD 

INTEGER*', 

number  of  the  key  field 

INA(  ) 

BYTE 

array  of  pointers  for  start  of  each 
field  in  current  category  record 

I  NB  (  ) 

BYTE 

array  of  pointers  for  end  of  each 
field  in  current  category  record 

ONE, NINE 

BYTE 

parameter  set  equal  to  1,9 

HOW  (  ) 

CHARACTER*6 

array  of  record  formats 

OUTPUTS: 

none 

EXTERNALS: 

FETCH, RECOUT, VERIFY, BTREE.RECIN, INSERT 
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SUBROUTINE  OELREC 

PURPOSE:  To  control  the  logic  for  deleting  a  data  record. 

INPUTS: 


CATNANE 

CHARACTER*9 

name  of  the  current  category 

NFIELD 

I NTEGER*4 

number  of  current  fields 

KEYFLD 

INTEGER*4 

number  of  the  key  field 

T I TLE (  ) 

CHARACTER*lO 

array  of  field  names 

ONE, NINE 

BYTE 

parameter  set  equal  to  1,9 

HOW  (  ) 

CHARACTER*6 

array  of  record  formats 

OUTPUTS: 

none 


EXTERNALS: 

BTREE,OPENCAT,VAL,RECOUT , SHOWREC , REC I N 
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SUBROUTINE  FETCH 


PURPOSE:  To  retrieve  a  data  record  in  the  current  category. 


INPUTS: 


CATNAME 

CHARACTER*9 

KEYFLD 

I  NTEGERM 

T I TL E  (  ) 

CHARACTER*'10 

TYPE  (  ) 

INTEGERS 

WHERE  (  ) 

CHARACTERS 

I0(  ) 

BYTE 

HOW  (  ) 

CHARACTERS 

ONE 

BYTE 

OUTPUTS: 

RECDATA 

CHARACTER*256 

EXTERNALS: 

SYM, ENDATE, TAB LIST, BTREE 


name  of  the  current  category 

number  of  the  key  field 

array  of  field  names 

array  of  field  data  types 

array  of  resource  categories 

array  of  unit  number  links  between 
fields  and  resource  categories 

array  of  record  formats 

parameter  set  equal  to  1 

data  record  in  current  category 


A-l  2 
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PURPOSE: 

INPUTS: 

CATNAME 

ONE 

HOW  (  ) 

OUTPUTS: 

none 

EXTERNALS: 


SUBROUTINE  GETREC 

To  control  the  logic  for  getting  a  data  record. 

CHARACTER*9  name  of  current  category 

BYTE  parameter  set  equal  to  1 

CHARACTER*6  array  of  record  formats 


FETCH, RECOUT.SHOWREC 
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SUBROUTINE  INSERT 


PURPOSE: 

To  insert  a  data 

i  record  into  the  current  category. 

INPUTS: 

CATNAME 

CHARACTER*9 

name  of  the  current  category 

NFIELD 

I  NTEGERM 

number  of  current  fields 

KEYFLD 

I NTEGERM 

number  of  the  key  field 

FL0(  ) 

CHARACTER*100 

array  of  field  data  in  internal 
format 

I  N  A  (  ) 

BYTE 

array  of  pointers  for  start  of  each 
field  in  current  category  record 

I NB  (  ) 

BYTE 

array  of  pointers  for  end  of  each 
field  in  current  category  record 

ONE 

BYTE 

parameter  set  equal  to  1 

HOW  (  ) 

OUTPUTS: 

none 

EXTERNALS: 

BTREE 

CHARACTERS 

array  of  record  formats 

A-10 
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SUBROUTINE  VERIFY 


PURPOSE: 

To  verify  a  data 

record . 

INPUTS: 

NFIELO 

INTEGERM 

number  of  current  fields 

FLO(  ) 

CHARACTERMOO 

array  of  field  data  in 
format 

external 

title (  ) 

CHARACTER*10 

array  of  field  names 

OUTPUTS: 

FLO(  ) 

CHARACTERMOO 

updated  array  of  field 
external  format 

data  in 

EXTERNALS: 


SHOWREC .CHECK, TAB LIST 
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INPUTS: 


OUTPUTS: 


none 


EXTERNALS: 


SUBROUTINE  AOOREC 


PURPOSE 


To  control  the  logic  for  adding  a  record. 


NFIELO 


INTEGERM 


number  of  current  fields 


KEYFLD 


title (  ) 

TYPE (  ) 


INTEGERM 

CHARACTER*10 


INTEGERM 


number  of  the  key  field 
array  of  field  names 
array  of  field  data  types 


EXA(  ) 


EXB(  ) 


BYTE 


BYTE 


array  of  pointers  for  start  of  duplicate 
fields  in  resource  category  records 

array  of  pointers  for  end  of  duplicate 
fields  in  resource  category  records 


TABLIST, VERIFY, RECIN, INSERT 
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SUBROUTINE  DELCAT 

PURPOSE:  To  control  the  logic  for  deleting  a  category. 

INPUTS: 

CATNAME  CHARACTER*9  name  of  the  current  category 

HOW ( 9 )  CHARACTER  record  format  for  CAT. OAR 

HOW ( 10 )  CHARACTER*6  record  format  for  (CATNAME ) .LAR 

OUTPUTS: 

none 

EXTERNALS: 

BTREE 
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SUBROUTINE  OPENCAT 


PURPOSE: 

To  initialize 

the  parameters  of  the  current  category. 

INPUTS: 

HOW ( 10 ) 

CHARACTER*6 

record  format  for  ( CATNAME ) .LAR 

CATNAME 

CHARACTERS 

name  of  the  current  category 

NF I  ELD 

INTEGERM 

number  of  current  fields 

OUTPUTS: 

I0(  ) 

BYTE 

array  of  unit  number  links  between 
fields  and  resource  categories 

title (  ) 

CHARACTERS!) 

array  of  field  names 

TYPE  (  ) 

INTEGERM 

array  of  field  data  types 

LONG (  ) 

I  NTEGERM 

array  of  field  lengths 

WHERE  (  ) 

CHARACTERS 

array  of  resource  categories 

I NA  (  ) 

BYTE 

array  of  pointers  for  start  of  each 
field  in  current  category  record 

INB(  ) 

BYTE 

array  of  pointers  for  end  of  each 
field  in  current  category  record 

EXA(  ) 

BYTE 

array  of  pointers  for  start  of  duplicate 
fields  in  resource  category  records 

E  XB  (  ) 

BYTE 

array  of  pointers  for  end  of  duplicate 
fields  in  resource  category  records 

NREF 

BYTE 

number  of  related  categories  with 
respect  to  current  category 

HOW  (  ) 

CHARACTERS 

array  of  record  formats 

EXTERNALS: 

BTREE 
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SUBROUTINE  PICKCAT 

PURPOSE:  To  either  delete  a  category  selected  by  the  user, 

or  open  a  category  and  execute  category  requests. 


INPUTS: 
HOW ( 9 ) 

OUTPUTS: 

CATNAME 

KEYFLD 

NFIELO 


CHARACTERS  record  format  for  CAT.DAR 


CHARACTERS 

INTEGERS 

INTEGERS 


name  of  the  current  category 
number  of  the  key  field 
number  of  current  fields 


EXTERNALS: 

BTREE, CHECK, TABMENU, OELCAT .OPENCAT , ADDREC , GETREC , DELREC .HODREC , 
QUERY, CAT LIST, MODWORD, REVIEW 
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SUBROUTINE  VIEWSPEC 


PURPOSE: 

To  review  the  field  parameters  of  the  current 
category;  editing  permitted  during  category 
creation  only. 

INPUTS: 

HOW ( 10 ) 

CHARACT£R*6 

record  format  for  (CATNAME ) .LAR 

CATNAME 

CHARACTER*9 

name  of  the  current  category 

KEYFLD 

INTEGERM 

number  of  the  key  field 

title (  ) 

CHARACTER*10 

array  of  field  names 

TYPE  (  ) 

INTEGERM 

array  of  field  data  types 

LONG(  ) 

INTEGERM 

array  of  field  lengths 

WHERE  (  ) 

CHARACTERS 

array  of  resource  categories 

NEW 

LOGICAL*! 

.TRUE,  upon  category  creation, 
.FALSE,  otherwise 

OUTPUTS: 

TITLE  (  ) 

CHARACTER*10 

array  of  field  names 

TYPE  (  ) 

I NTEGER*4 

array  of  field  data  types 

LONG  (  ) 

I NTEGER*4 

array  of  field  lengths 

WHERE  (  ) 

CHARACTER*9 

array  of  resource  categories 

EXTERNALS: 
CHECK, SYM 
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SUBROUTINE  NEWCAT 


PURPOSE: 

To  create  a  new 

category  . 

INPUTS: 

HOW ( 9 ) 

CHARACTER*6 

record  format  for  CAT.DAR 

HOW ( 10 ) 

CHARACTER*6 

record  format  for  (CATNAME ) .LAR 

OUTPUTS: 

CATNAME 

CHARACTER*9 

name  of  the  current  category 

NFIELD 

INTEGERM 

number  of  current  fields 

KEYFLD 

INTEGERM 

number  of  the  key  field 

MAXLEN 

INTEGERM 

length  of  the  key  field 

T I T  L  E  (  ) 

CHARACTER*10 

array  of  field  names 

TYPE  (  ) 

I NTEGER*4 

array  of  field  data  types 

WHERE  (  ) 

CHARACTER*9 

array  of  resource  categories 

LONG (  ) 

I NTEGER*4 

array  of  field  lengths 

NEW 

LOGICAL*! 

.TRUE,  upon  category  creation. 

.FALSE,  otherwise 


EXTERNALS: 


CHECK, SYM 
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PROGRAM  BOSS 


PURPOSE:  To  open  the  database  and  control  the  logic  needed 

to  execute  user  requests. 

INPUTS: 
none 

OUTPUTS: 

HOW ( 9 ) 

HOW ( 10 ) 

EXTERNALS: 

BTREE, CHECK, PIC KC AT, NEWCAT 


CHARACTER*6  record  format  for  CAT.DAR 

CHARACTER*6  record  format  for  ( CATNAME ) .LAR 
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SUBROUTINE  REVIEW 

PURPOSE:  To  select  a  field  and  review  i 

INPUTS: 

none 

OUTPUTS: 

none 

EXTERNALS: 


s  parameters 


FLOLIST, VIEWSPEC 
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PURPOSE: 

INPUTS: 
CATNAME 
NFIELD 
TITLE  (  ) 

OUTPUTS: 

N 


SUBROUTINE  FLDLIST 

To  list  the  field  names  of  the  current  category 
and  select  one  of  them. 


CHARACTER*9 

INTEGERM 

CHARACTER*10 


name  of  the  current  category 
number  of  current  fields 
array  of  field  names 


INTEGER*4  number  of  selected  field 


EXTERNALS: 
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SUBROUTINE  RECIN 

PURPOSE:  To  transform  a  record  from  external  format  Into 


internal  format. 

INPUTS: 


NFIELD 

INTEGERM 

FLO  (  ) 

CHARACTER*100 

T YPE (  ) 

INTEGERM 

title (  ) 

CHARACTERMO 

WHERE  (  ) 

CHARACTERS 

I0(  ) 

BYTE 

TEN 

BYTE 

OUTPUTS: 

fld (  ) 

CHARACTER*10 

EXTERNALS: 


number  of  current  fields 

array  of  field  data  in  external 
format 

array  of  field  data  types 

array  of  field  names 

array  of  resource  categories 

array  of  unit  number  links  between 
fields  and  resource  categories 

parameter  set  equal  to  10 

array  of  field  data  in  internal 
format 


SYM .ENDATE , BTREE 


SUBROUTINE  RECOUT 


PURPOSE:  To  transform  a  record  from  internal  format  into 

external  format. 

INPUTS: 


NFIELD 

INTEGERM 

number  of  current  fields 

I N  A  (  ) 

BYTE 

array  of  pointers  for  start  of  each 
field  in  current  category  record 

I  NB  (  ) 

BYTE 

array  of  pointers  for  end  of  each 
field  in  current  category  record 

RECDATA 

CHARACTER*256 

data  record  in  current  category 

TEN 

BYTE 

parameter  set  equal  to  10 

IO(  ) 

BYTE 

array  of  unit  number  links  between 
fields  and  resource  categories 

HOW  (  ) 

CHARACTER*6 

array  of  record  formats 

TITLE  (  ) 

CHARACTER*10 

array  of  field  names 

TYPE  (  ) 

I NTEGERM 

array  of  field  data  types 

EXA(  ) 

BYTE 

array  of  pointers  for  start  of  duplicate 
fields  in  resource  category  records 

EXB(  ) 

BYTE 

array  of  pointers  for  end  of  duplicate 
fields  in  resource  category  records 

OUTPUTS: 

FLD(  ) 

CHARACTER*10 

array  of  field  data  in  external 
format 

EXTERNALS: 


VAL.BTREE 
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SUBROUTINE  SHOWREC 

PURPOSE:  To  display  a  record  on  the  screen. 

INPUTS: 

NFIELD  INTEGERM  number  of  current  fields 

TITLE (  )  CHARACTER*10  array  of  field  names 

FLD(  )  CHARACTER*10  array  of  field  data  in  external 

format 

OUTPUTS: 

none 

EXTERNALS: 

none 


**50  -.TO.OV* 
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PURPOSE: 

INPUTS: 
HOW  (  ) 
TYPE (  ) 
ONE, SIX 

OUTPUTS: 

none 


SUBROUTINE  QUERY 

To  control  the  logic  for  a  range  query. 


CHARACTER*6 

INTEGERM 

BYTE 


array  of  record  formats 
array  of  field  data  types 
parameter  set  equal  to  1,6 


EXTERNALS: 

FLOL  1ST, CHECK, S YM , ENDATE , BTREE , RECOUT , VAL , CONVERT,  OUTPUT 


I 
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PURPOSE: 

INPUTS: 

none 


SUBROUTINE  CATLIST 

To  write  the  number  of  every  record  of  the 
current  category  on  a  scratch  file. 


OUTPUTS: 

none 

EXTERNALS: 
BTREE, OUTPUT 
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SUBROUTINE  OUTPUT 


PURPOSE: 

To  write  a  set 

of  records  on  an  output  file. 

INPUTS: 

CATNAHE 

CHARACTER*9 

name  of  the  current  category 

NFIELD 

I NTEGERM 

number  of  current  fields 

TITLE(  ) 

CHARACTER*10 

array  of  field  names 

TYPE  (  ) 

INTEGERM 

array  of  field  data  types 

EXA(  ) 

BYTE 

array  of  pointers  for  start  of  duplicate 
fields  in  resource  category  records 

exb  (  ) 

BYTE 

array  of  pointers  for  end  of  duplicate 
fields  in  resource  category  records 

OUTPUTS: 

none 

EXTERNALS: 

FLDLIST.RECOUT 


SUBROUTINE  TABMENU 


PURPOSE:  To  control  the  logic  for  a  "TABLE"  request. 

INPUTS: 

HOW(  )  CHARACT£R*6  array  of  record  formats 

FIVE, NINE  BYTE  parameter  set  equal  to  5,9 

OUTPUTS: 

none 

EXTERNALS: 

BTREE , CHECK, TABL 1ST, TABDEL , TABADD 
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SUBROUTINE  TABADD 

PURPOSE:  To  add  a  record  to  "TABLE". 

INPUTS: 

FLDNAME  CHARACTER*10  name  of  table  field 

TEN  BYTE  parameter  set  equal  to  10 

OUTPUTS: 

none 

EXTERNALS: 

BTREE 
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SUBROUTINE  TABDEL 

PURPOSE:  To  delete  a  record  from  “TABLE". 

INPUTS: 

FLDVAL  CHARACTER*10  value  of  table  field 

FLDNAME  CHARACTERMO  name  of  table  field 

ONE, NINE, TEN  BYTE  parameter  set  equal  to  1,9,10 

HOW (  )  CHARACTER*6  array  of  record  formats 

NREF  BYTE  number  of  related  categories 

respect  to  current  category 

OUTPUTS: 

none 

EXTERNALS: 

BTREE,VAL,OPENCAT,RECOUT,SHOWREC 


with 
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SUBROUTINE  TABLIST 

PURPOSE:  To  list  all  the  current  values  of  a  field 

with  table  type  data. 

INPUTS: 

FLDNAME  CHARACTER*10  name  of  table  field 

TEN  BYTE  parameter  set  equal  to  10 

IND  INTEGERM  indicator  which  selects 

appropriate  screen  message 

OUTPUTS: 

FLDVAL  CHARACTER*10  value  of  table  field 

EXTERNALS: 

BTREE, CHECK 
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SUBROUTINE  CHECK 

PURPOSE:  To  trap  a  particular  class  of  typographical  error. 

INPUTS: 

ANS  CHARACTER*3  numerical  user  input  in  string 

format 

NMAX  INTEGERM  largest  admissible  value  for  user 

i  nput 

OUTPUTS: 

N  INTEGER*4  integer  value  of  user  input 

EXTERNALS: 


none 
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FUNCTION  ENDATE 

PURPOSE:  To  convert  the  date  passed  by  WHEN  into  the 

number  of  days  since  December  31,1899. 

INPUTS: 

WHEN  CHARACTER*10  date  in  string  format 

OUTPUTS: 

ENDATE  INTEGERM  number  of  days  since  December  31,1899 

associated  with  WHEN 

EXTERNALS: 

none 
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HOW ( 1 )  =  ' (A'//HOW(l) ( 1 : K ) / / '  )  1 
NREF  =  1 

DO  4040  I  =  1 , NF I  ELD 
IF  ( TYPE ( I )  .LE .2 )  THEN 
EXA(I)  =  INA(I) 

EXB(I)  =  INB(I) 

ELSE  IF  ( TYPE ( I  )  .EQ . 4 )  THEN 
10(1)  =  10 

ELSE  IF  ( T YPE (  I )  .EQ . 5 )  THEN 
NREF  =  NREF  +  1 
10(1)  =  NREF 
LTR  =  'O' 

A  =  WHERE  (  I  ) 

CALL  BTREE(LTR,NREF,A,MAXLEN,  IREC  ,IERR) 

LDU  =  NREF  +  10 
CLOSE ( UN  I T  =  LDU ) 

OPEN(UNIT=LDU,FILE=WHERE(  I  )//'  .DAR' , STATUS= 1  OLD '  , 

*  FORM= ' FORMATTED AC CESS=' DIRECT') 

LTR  =  ' G ' 

CALL  BTR EE (LTR, NINE ,A,MAXLEN,  IREC , I  ERR) 
READ(19,H0W(9)  , REC  =  I REC  )  RECDATA 
MEND  =  VAL(RECDATA(20:  21  )  ) 

CLOSE (UNIT=20) 

0PEN(UNIT  =  20,FILE=WHERE(  I  )//'  .LAR ' ,  STATUS  =  ' OLD ' , 

*  FORM=' FORMATTED' ,ACCESS='DIRECT') 

DO  4020  M=1 ,MEND 

READ(20,H0W(10) ,REC=M)  RECDATA 
IF  (M.EQ.l)  THEN 
MA  =  1 

MB  =  VAL(RECDATA( 11 : 12)  ) 

ELSE 

MA  =  MB  +  1 

MB  =  MB  +  VAL ( RECDATA( 11:12)) 

END  IF 

IF  (TITLE(I) .EQ.RECDATA(1  :10))  THEN 
EXA(I)  =  MA 
EXB  (  I )  =  MB 
END  IF 

4020  CONTINUE 
K  =  1 

DO  WHILE  (MB/10**K.GT.0) 

K  =  K  +  1 
END  DO 

ENC0DE(K,402,H0W(NREF)  )  MB 

HOW ( NREF  )  =  ' (A' //HOW(NREF)  ( 1  :K)//*  )  ' 

END  IF 

4040  CONTINUE 
RETURN 
END 
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SUBROUTINE  OPENCAT 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20) , 

2  10 (20)  ,ANS, TYPE (20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW ( 10 )  ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FI VE ,SIX, SEVEN, EIGHT,  NINE,  TEN 
BYTE  INA,INB .EXA.EXB , 10 , IERR  ,NREF 

CHARACTER  LTR*1,H0W*6 ,C ATNAME *9 , WHERE *9 , T I TLE *10 
CHARACTER  ANS*3 , A*20 ,FLD*100 ,RECDATA*256 
C 

402  FORMAT ( I <K>  ) 


INITIALIZE  CATEGORY  PARAMETERS 


LTR  =  ’O' 

A  =  CATNAME 

CALL  BTREE(LTR,ONE,A,MAXLEN, IREC , IERR ) 

CLOSE (UNIT=11 ) 

0PEN(UNIT  =  11,FILE=CATNAME//'  .DAR' ,  STATUS  =  ' OLD ' , FORM= ' FORMATTED 

*  ACCESS=‘ DIRECT' ) 

CLOSE ( UN  I T  =  20 ) 

0PEN(UNIT=20,FILE=CATNAME//' .LAR' ,STATUS=‘ OLD ' , FORM3 ' FORMATTED 

*  ACCESS3' DIRECT' ) 

LENREC  =  0 

DO  4005  I  =  1 ,  NF I  ELD 
10(1)  =  1 

READ(20,H0W(10) ,REC=I )  RECDATA 
TITLE ( I )  =  RECDATA( 1:10) 

LONG ( I )  =  VAL(RECDATA(11  :  12  )) 

LENREC  =  LENREC  +  LONG(I) 

IF  (I.EQ.l)  THEN 
INA(I)  =  1 
INB (  I  )  =  LONG (  I  ) 

ELSE 

I NA ( I )  =  INB(I-l)  +  1 
I NB (  I  )  =  I  NB ( I - 1 )  +  LONG ( I ) 

END  IF 

TYPE(I)  =  VAL(RECDATA(13:  14)) 

WHERE ( I )  =  R  ECDATA ( 1 5 : 2  3) 

4005  CONTINUE 
K  =  1 

DO  WHILE  ( INB(NFIELD)/10**K.GT.0) 

K  =  K  +  1 
END  DO 

ENCODE (K ,402 ,HOW( 1 ) )  LENREC 
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C 

C 

3045 

C 


3060 

C 


CALL  DELCAT 
ELSE 

SELECT  AND  EXECUTE  A  CATEGORY  REQUEST 

CALL  OPENCAT 

WR I TE ( 22 , 3 1 7  )  CATNAME 

WRITE (22, 318) 

READ (21, 302)  ANS 

CALL  CHECK(ANS, ACT, TEN, TYPO) 

IF  (TYPO)  GO  TO  3045 

IF  (ACT.EQ.l)  THEN 
CALL  ADDREC 

ELSE  IF  (ACT.EQ.2)  THEN 
CALL  GETREC 

ELSE  IF  (ACT.EQ.3)  THEN 
CALL  DELREC 

ELSE  IF  (ACT.EQ.4)  THEN 
CALL  MODREC 

ELSE  IF  (ACT.EQ.5)  THEN 
CALL  QUERY 

ELSE  IF  (ACT.EQ.6)  THEN 
CALL  CATLIST 
ELSE  IF  (ACT.EQ.7)  THEN 
CALL  MODWORD 
ELSE  IF  ( ACT.EQ  .8)  THEN 
CALL  REVIEW 

ELSE  IF  (ACT.EQ. 9)  THEN 
READ (  1 , 303  ,REC  =  1 )  I,J 
K  =  J  -  I 

WR I TE ( 6 , 321 )  CATNAME, K 
ELSE  IF  (ACT.EQ. 10)  THEN 
DO  3060  I  =  1 ,  NF I  ELD 
LDU  =  10(1)  +  10 
CLOSE ( UN  I  T  =  LDU  ) 

CONTINUE 
RETURN 
END  IF 
GO  TO  3045 

END  IF 
END 
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KOUNT  =  1 

FLO ( 1 )  =  'TABLE' 

WR I TE ( 2 2 , 30 1  )  KOUNT, FLD(l) 

LTR  =  'F' 

3010  CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,IERR) 
IF  (IERR.EQ.4.0R.IERR.EQ.5)  GO  TO  3020 
LTR  =  'S' 

KOUNT  =  KOUNT  +  1 

FLO ( KOUNT )  =  A 

L I NK ( KOUNT  )  =  IREC 

WR I TE ( 22 , 301 )  KOUNT, A 

IF  (M0D(K0UNT,20)  .  EQ  .  0  )  THEN 

3015  WR I TE ( 22 , 31 1 ) 

READ(21,302)  ANS 

CALL  CHECK(ANS,N, KOUNT, TYPO) 

IF  (TYPO)  GO  TO  3015 
IF  (N.NE.O)  GO  TO  3030 
KOUNT  =  0 
END  IF 
GO  TO  3010 

3020  WRITE(22,312) 

WR I TE ( 22 , 3 1 3 ) 

READ (21, 302)  ANS 

CALL  CHECK(ANS,N, KOUNT, TYPO) 

IF  (TYPO)  GO  TO  3020 
IF  (N.EQ.O)  RETURN 
C 

3030  IF  (FLD(N)(1:5).EQ. 'TABLE')  THEN 
IF  (NUM.EQ.l)  THEN 
CALL  TABMENU 
ELSE  IF  (NUM.EQ.2)  THEN 
WR  I  TE ( 22 , 314  ) 

END  IF 
RETURN 
END  IF 

READ(19,H0W(9),REC=LINK(N))  RECDATA 
CATNAME  =  RECDATA(  1:9) 

CATWORD  =  RECDATA(  10:  19) 

NF I  ELD  =  VAL(RECDATA(20:21 ) ) 

KEYFLD  =  VAL(RECDATA(22:23)) 

IF  (CATWORD  .EQ. '  ' )  GO  TO  3035 
WR I TE ( 22 , 3 1 5  ) 

READ ( 2 1 , 302  )  TRY 
IF  (TRY. EQ. CATWORD)  THEN 
GO  TO  3035 
ELSE 

WRITE(22,316) 

RETURN 
END  IF 

3035  IF  (NUM.EQ.2)  THEN 
C 

C  DELETE  A  CATEGORY 
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SUBROUTINE  PICKCAT(NUM) 

IMPLICIT  INTEGER*4  (A-Z) 

COMMON  /XXXBOSS/ 

1  NF I  ELD , KE YFLD , CATNAME ,R£CDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS,TYPE(20) ,FLD (20) .TITLE (20) .WHERE (20)  , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN. EIGHT, NINE,  TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO, IERR.NREF 

CHARACTER  LTR*1 , HO W*6 .CAT NAME *9 ,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 , FLD*100 ,RECDATA*256 

INTEGER  L I NK ( 20  ) 

CHARACTER  TRY*10 ,CATW0RD*10 
L0GICAL*1  THERE, TYPO 

301  F0RMAT(11X, I3,15X,A10) 

302  FORMAT ( A 1 0  ) 

303  FORMAT (215) 

310  F0RMAT(/10X, 'NUMBER' ,10X, 'CATEGORY  NAME'/) 

311  F0RMAT(/3X, 'ENTER  THE  APPROPRIATE  NUMBER  OR  ENTER'/ 

*7X , ' ZERO  TO  SEE  MORE  LIST' ) 

312  F0RMAT(/3X, 'ENTER  THE  APPROPRIATE  NUMBER') 

313  FORMAT ( 3X , 'OR  ENTER  ZERO  TO  RETURN  TO  PREVIOUS  MENU’) 

314  F0RMAT(/3X, 'REQUEST  DENIED  -  "TABLE"  CANNOT  BE  DELETED’/) 

315  F0RMAT(/3X, 'ENTER  CATEGORY  PASSWORD’) 

316  F0RMAT(/3X, ' INCORRECT  CATEGORY  PASSWORD') 

317  F0RMAT(/15X, 'THE  CURRENT  CATEGORY  IS  ' ,A8 ,//) 

318  FORMAT (10X, 'NUMBER' , 10X ,' ACTION ' // 


*  12X , 

'  1 ' 

,13X, 

'ADD  DATA'/ 

*12X , 

'2' 

,  1 3X , 

•GET  DATA'/ 

*12X , 

'3' 

» 13X , 

'DELETE  DATA'/ 

*12X , 

■  4' 

» 13X , 

'MODIFY  DATA'/ 

*12X , 

'5' 

» 13X , 

'RANGE  QUERY'/ 

*12X , 

'6' 

,13X, 

'LIST  ENTIRE  CATEGORY'/ 

*12X , 

'7' 

» 13X , 

'CHANGE  CATEGORY  PASSWORD'/ 

*12X , 

'8' 

» 1 3X , 

'DISPLAY  RECORD  FORMAT’/ 

*12X , 

'9' 

,  13X , 

'CURRENT  NUMBER  OF  RECORDS'/ 

*1 2X , 

'  10 

'  ,  12X 

, 'RETURN  TO  PREVIOUS  MENU'/ 

*/  3X , 

'ENTER  APPROPRIATE  NUMBER') 

321  F0RMAT(/3X, 'CURRENT  NUMBER  OF  RECORDS  IN  CATEGORY  ’,A9,' 


DRIVER  FOR  CATEGORY  REQUEST 


SELECT  A  CATEGORY 
3005  WR I TE ( 22 , 310  ) 


NS WC  TR  85-56 


WRITE(22,612)  K,B(J) 

IF  (J.LE.2)  THEN 
K  =  3 

WR  I TE ( 22 , 61 3 )  K ,  LONG ( I ) 

ELSE 

LONG ( I )  =  2 
IF  (J.EQ.5)  THEN 
K  =  4 

WR I TE ( 22 , 614 )  K  ,  WHERE ( I ) 
END  IF 
END  IF 

IF  ( I .EQ.KEYFLD)  WR I TE ( 22 , 61 5 ) 

IF  (.NOT. NEW)  RETURN 
6015  WRITE (22 ,616) 

READ (21, 601)  ANS 

CALL  CHECK(ANS,NUM, FOUR, TYPO) 

IF  (TYPO)  GO  TO  6015 
IF  (NUM.EQ.O)  GO  TO  6020 
WRITE(22,617) 

IF  (NUM.EQ.l)  THEN 

READ (21,601)  TITLE(I) 

ELSE  IF  (NUM.EQ.2)  THEN 
WRITE (22, 618) 

READ ( 21  ,*  )  TYPE (  I  ) 

ELSE  IF  (NUM.EQ.3)  THEN 
READ(21  ,*)  LONG ( I ) 

ELSE  IF  (NUM.EQ.4)  THEN 
READ (21,601)  WHERE ( I  ) 

END  IF 
GO  TO  6010 

6020  RECDATA( 1:10)  =  TITLE(I) 

RECDATA( 11:12)  =  SYM(LONG(I)) 
RECDAT A ( 1 3 : 14 )  =  SYM (TYPE ( I ) ) 
RECDAT  A ( 1 5 : 23 )  =  WHERE ( I ) 
WRITE(20,H0W(10),REC=I)  RECDATA 
RETURN 
END 
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C 

C 


C 


C 

C 


SUBROUTINE  V IEWSPEC( I , NEW) 
IMPLICIT  INTEGERM  (A-Z) 


COMMON  /XXXBOSS/ 

1  NF I ELO , KEYFLD .CATNAME ,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS,TYPE( 20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO. THREE, FOUR, FIVE, SIX, SEVEN. EIGHT, NINE. TEN. 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) , E  XB ( 20 ) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1 , H0W*6 ,CATNAME*9 , WHERE*9 ,T ITLE*10 
CHARACTER  ANS*3 ,A*20 ,FLD*100 ,RECDATA*256 

CHARACTER  S YM*2 , B ( 5 ) *10 
LOG  I  CALM  NEW, TYPO 

DATA  B/' CHARACTER* ,‘ NUMERICAL' ,'DATE' .'TABLE' .'DUPLICATE'/ 


601  FORMAT 

610  FORMAT 

611  FORMAT 

612  FORMAT 

613  FORMAT 

614  FORMAT 

615  FORMAT 

616  FORMAT 
*8X , ' OF 

617  FORMAT 

618  FORMAT 
*15X ,  '  1 
*  1 5X  ,  '2 
*15X , '  3 
*1 5X ,  '4 
*15X , '  5 


(A10) 

( / 15X , 'FIELD' ,13,'  PARAMETERS') 

(/5X.I3.5X, 'TITLE' .T50.A10) 

( 5X , 1 3 , 5X , ' DATA  TYPE ' , T50 , A10 ) 

(5X, 13, 5X, 'MAXIMUM  NUMBER  OF  CHARACTERS ', T50 , 1 3 ) 

(5X,  1 3, 5X,' RESOURCE  CATEGORY ' ,T50 ,A9) 

( / 5 X , ' ***  -  KEY  FIELD*) 

(/3X, 'ENTER  ZERO  IF  SATISFACTORY  OR  ENTER  THE  NUMBER'/ 
THE  PARAMETER  TO  BE  MODIFIED') 

(/3X, 'ENTER  NEW  PARAMETER') 

(  /10X ' DATA  TYPE'// 


CHARACTER'/ 
NUMERICAL '/ 
DATE  (FROM  1 
TABLE '/ 
DUPLICATE'/) 


JAN  1900  TO  1  JAN  2076) '/ 


REVIEW  THE  FIELD  PARAMETERS  FOR  A  CATEGORY 
(EDITING  PERMITTED  UPON  CATEGORY  CREATION) 


WRITE(22,610)  I 
6010  J  =  TYPE(I) 

IF  (J.LE.3)  THEN 

WHERE ( I )  -  CATNAME 
ELSE  IF  (J.EQ.4)  THEN 
WHERE ( I )  *  'TABLE' 

END  IF 
K  -  1 

WR ITE ( 22 , 61 1 )  K.TITLE(I) 
K  »  2 
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■nr 


WR ITE ( 22, 212  ) 

READ (21,201)  CATWORD 
WRITE (22, 213 ) 

READ (21 ,* )  NF I  ELD 
LENREC  =  0 
DO  2010  I  =  1 , NF I  ELD 
WRITE(22,214)  I 
READ ( 21 , 20 1 )  TITLE ( I ) 

WR I TE ( 22 , 2 1 5 ) 

READ (21  ,*  )  TYPE  ( I ) 

LONG ( I )  =  2 

IF  (TYPE(I)  .  LE  .  2  )  THEN 
WRITE (22, 216) 

IF  (TYPE ( I )  .EQ  .2  )  WR I TE ( 22 , 21 7  ) 

READ ( 21 ,  *  )  LONG ( I ) 

ELSE  IF  (TYPE (I). EQ. 5)  THEN 
WRITE(22,218) 

READ ( 2 1 , 20 1 )  WHERE  ( I ) 

END  IF 

LENREC  =  LENREC  +  LONG(I) 

2010  CONTINUE 

WRITE(22,219) 

READ ( 2 1 ,* )  KEYFLD 
NEW  =  .TRUE. 

DO  2020  I  3 1 , NF  I  ELD 
CALL  V I EWSPEC ( I , NEW ) 

2020  CONTINUE 
LTR  =  *  A  * 

A  =  CATNAME 

CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,IERR) 

RECDATA  =  CATNAME 
RECDATA  ( 10:19)  =  CAT'.’ORD 
RECDAT  A ( 20 : 2 1 )  =  SYM(NFIELD) 

RECDATA ( 22:23)  =  SYM(KEYFLD) 

WRITE(19,H0W(9)  ,REC  =  IREC)  RECDATA 
LTR  =  'C' 

A  =  CATNAME 

MAXLEN  =  LONG(KEYFLD) 

CALL  BTREE ( LTR .ONE ,A .MAXLEN  ,  IREC  ,  I  ERR) 

CLOSE (UN  I T*1 1 ) 

OPEN (UN  IT-11,  FILE -CATNAME//'  .DAR' .STATUS  3 ' NEW ’ ,FORM  =  ' FORMATTED  ’  , 
*  ACCESS3 ' DIRECT '  ,RECL  =  LENREC  ) 

RETURN 

END 
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C 

C 


c 


c 


SUBROUTINE  NEWCAT 
IMPLICIT  I NTEGER*4  (A-Z) 

COMMON  /XXXBOSS/ 

1  NF I  ELD , KEYFLD .CATNAME ,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS,TYPE (20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR, INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB, 10, IERR.NREF 

CHARACTER  LTR*1 , HOW* 6 .CATNAME *9 ,WHERE*9,TITLE*10 
CHARACTER  ANS*3 , A*20 , FLD* 100 , R ECDATA*256 

CHARACTER  SYM*2,CATW0RD*10 
LOGICAL*!  THERE, NEW 


201  FORMAT ( A 1 0  ) 

210  FORMAT ( / 3 X , 

211  FORMAT ( /10X 

212  FORMAT ( / 3 X  . 
*5X , ' IF  NONE 

213  FORMAT ( / 3 X , 

214  FORMAT ( / 1 5 X 
*3X, 'ENTER  F 

215  FORMAT ( /10X 
*15X ,  1 1 
*15X,  '  2 
*15X ,  1  3 
*15X,'4 
*15X,'5 
*/3X , 'ENTER 

216  FORMAT ( /3X , 

217  FORMAT ( 3X  ,  ' 

218  FORMAT ( / 3X , 

219  FORMAT ( /3X , 


RECORD' ) 
) 


'ENTER  NAME  OF  NEW  CATEGORY  (AT  MOST  9  CHARACTERS)') 
.'CATEGORY  NAME  ALREADY  IN  USE  -  CHOOSE  ANOTHER') 
'ENTER  CATEGORY  PASSWORD  (AT  MOST  10  LETTERS)  -'/ 
SIMPLY  PRESS  THE  "RETURN"  KEY') 

'  ENTER  NUMBER  OF  FIELDS  PER  DATA 
, 'PARAMETERS  OF  FIELD', 13// 

I  ELD  NAME  (AT  MOST  10  CHARACTERS)1 
'DATA  TYPE'// 

CHARACTER'/ 

NUMERICAL'./ 

DATE  (FROM  1  JAN  1900  TO  1  JAN  2076)'/ 

TABLE  '/ 

DUPLICATE  '/ 

NUMBER  CORRESPONDING  TO  DATA  TYPE') 

'ENTER  MAXIMUM  NUMBER  OF  CHARACTERS 
COUNTING  SIGNS  AND  DECIMAL  POINTS') 

'ENTER  RESOURCE  CATEGORY') 

'ENTER  NUMBER  OF  KEY  FIELD' ) 


) 


CREATE  A  NEW  CATEGORY 


WRITE(22,210) 

READ ( 2 1 , 20 1 )  CATNAME 

INQUIRE (FILE=CATNAME// '  .DAR ' , E X  I ST  =  THERE  ) 

IF  (THERE)  THEN 
WRITE (22, 211) 

RETURN 
END  IF 

CL0SE(UNIT=20) 

0PEN(UNIT  =  20,F ILE=CATNAME// '  .LAR ' , STATUS =' NEW ' , FORM* ' FORMATTED  '  , 
ACCESS=' DIRECT' ,RECL=23) 
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*10X, *3' ,10X, 'CREATE  A  NEW  CATEGORY'/ 
*10X  '4'  10X  'EXIT1/ 

* / 3 X * ' ENTER  APPROPRIATE  NUMBER') 


OPEN  THE  DATA  BASE 


OPEN ( UNI T®21,F I LE®'SYS$ INPUT' .STATUS® ' UNKNOWN  '  ) 
0PEN(UNIT=22,FILE='SYS$0UTPUT' , STATUS® ' UNKNOWN ' ) 

HOW ( 9 )  =  ' ( A23 ) ' 

HOW ( 10 )  ®  ' ( A23 ) ' 

INQUIRE ( F ILE® ' CAT. KEY ' , EX  I  ST  =  THE RE ) 

IF  (THERE)  THEN 
LTR  =  'O' 

ELSE 

LTR  =  'C' 

END  IF 
A  =  'CAT' 

MAXLEN  =  9 

CALL  BTREE( LTR, NINE, A, MAXLEN, IREC.IERR) 

CLOSE ( UN IT=19 ) 

OPEN  (UN  I  T  =  19,  FILE®' CAT. DAR ' , STATUS® 'UNKNOWN ' .FORM® 'FORMATTED  '  , 
*  ACCESS='DIRECT* ,RECL=23) 

A  =  'TABLE' 

MAXLEN  =  20 

CALL  BTREE( LTR, TEN, A, MAXLEN, IREC.IERR) 

1010  WRITE(22,110) 

READ (21,101)  ANS 

CALL  CHECK(ANS,NUM, FOUR, TYPO) 

IF  (TYPO)  GO  TO  1010 
IF  (NUM.EQ.1.0R.NUM.EQ.2)  THEN 
CALL  PICKCAT(NUM) 

ELSE  IF  (NUM.EQ.3)  THEN 
CALL  NEWCAT 

ELSE  IF  (NUM.EQ.4)  THEN 
STOP 
END  IF 
GO  TO  1010 
END 
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PROGRAM  BOSS 

BOSS  is  an  interactive  relational  database  manager 
which  uses  a  B+  tree  for  storing  and  retrieving  record 
keys.  This  implementation  can  accomodate  up  to  65,535 
data  records  in  any  one  category. 

Complete  documentation  for  BOSS  is  contained  in 
“BOSS  :  A  FORTRAN  Code  for  a  Relational  Database 
Manager"  by  Elliot  Winston,  NSWC  TR  85-56.  Associated 
documentation  can  be  found  in  "BTREE  :  A  FORTRAN 
Code  for  a  B+  Tree"  by  Elliot  Winston,  NSWC  TR  85-54. 


1 

( NREF  =  1 ) .KEY 

11 

(NREF-1 )  .DAR 

2 

(NREF  =  2)  .KEY 

12 

( NREF  =  2 )  .DAR 

8 

( NREF=8 )  .KEY 

18 

(NREF=8)  .DAR 

9 

CAT. KEY 

19 

CAT. DAR 

10 

TABLE .KEY 

20 

{***) . LAR 

21 

INPUT  (KEYBOARD) 

22 

OUTPUT  (SCRE 

23 

SCRATCH 

24 

SCRATCH 

MAXIMUM  NUMBER  OF  FIELDS  PER  RECORD  =  20 
MAXIMUM  FIELD  LENGTH  =  100  BYTES 
MAXIMUM  NUMBER  OF  BYTES  PER  RECORD  =  256 
MAXIMUM  NUMBER  OF  RELATED  CATEGORIES  =  8 

IMPLICIT  I NTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFIELD.KEYFLD.CATNAME , RECDATA , A , NREF , LONG ( 20 ) , 

2  10(20) ,ANS, TYPE (20) ,FLD( 20) , T I TLE ( 20 ) , WHERE ( 20 ) , 

3  ONE,  TWO,  THREE,  FOUR,  FIVE  ,SI.X,  SEVEN,  EIGHT,  NINE,  TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE , TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA, INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1 , H0W*6 , C ATNAME*9 , WHERE *9 , T I TLE*10 
CHARACTER  ANS*3,A*20,FLD*100,RECDATA*256 

LOG ICAL*1  THERE, TYPO 

DATA  ONE, TWO, THREE, FOUR, FIVE/ 1,2, 3, 4, 5/ 

DATA  SIX, SEVEN, EIGHT, NINE, TEN/6, 7, 8, 9, 10/ 

101  FORMAT ( A3 ) 

110  FORMAT( 'O' ,9X, '1 ' ,10X, 'ACCESS  AN  ACTIVE  CATEGORY'/ 

*10X, '2', 10X, 'DELETE  AN  ACTIVE  CATEGORY'/ 
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APPENDIX  B 

FORTRAN  CODE  LISTING 


FUNCTION  CONVERT 


PURPOSE:  To  convert  a  number  in  string  format  into 

its  real  numerical  value. 

INPUTS: 

A  CHARACTER*15  number  in  string  format 

OUTPUTS: 

CONVERT  REALM  real  value  associated  with  A 

EXTERNALS: 

none 


PURPOSE: 


INPUTS: 


MANY 


OUTPUTS: 


DEDATE 


EXTERNALS: 
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FUNCTION  DEDATE 


To  convert  the  number  of  days  since  December  31,1899 
into  the  format  MONTH/DAY/ YEAR  . 


INTEGER*4  number  of  days  since  December  31,1899 


CHARACTER*10  date  associated  with  MANY 


A  -30 


“S  V- VV-V-  V/' 


r*  *”>  /■  . 


*-  %  \  *.  •.  *. 
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SUBROUTINE  DELCAT 
C 

IMPLICIT  I NTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD, KEYFLD, CATNAME, RECDATA, A, NREF, LONG (20), 

2  10(20) ,ANS, TYPE (20) ,FLD( 20)  .TITLE (20)  .WHERE ( 20  )  , 

3  ONE, TWO, THREE, FOUR ,F I VE.SIX.SE VEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FI VE.SIX.SE VEN, EIGHT,  NINE,  TEN 
BYTE  INA,INB,£XA,EXB, IO,IERR,NREF 

CHARACTER  LTR*1 , HOW* 6 , CATNAME *9 , W HERE *9 , T I TLE*10 
CHARACTER  ANS*3 ,A*20 , FLD*100 ,RECDATA*256 
C 

CHARACTER  NAME*9 
C 

301  FORMAT (A3 ) 

310  FORMAT ( / 1  REQUEST  DENIED  -  ',A10,'  IS  REFERENCED  BY  *,A10) 

311  FORMAT ( /3X , 1  DO  YOU  WISH  TO  DELETE  CATEGORY  ',A9'?  ( Y /N )  '  ) 

312  FORMAT ( / 3 X 1  REQUEST  TO  DELETE  CATEGORY  '  ,A9,'  IS  CANCELLED') 


DRIVER  TO  DELETE  A  CATEGORY 


CHECK  FOR  RELATED  CATEGORIES 

CLOSE ( UN  I T  =  20  ) 

LTR  =  ' F  ' 

3010  CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,  IERR) 

IF  (IERR. EQ. 4. OR. IERR. EQ. 5)  GO  TO  3030 
LTR  =  'S' 

READ(19,H0W(9) ,REC=IREC)  RECDATA 
NAME  RECDATA(1:9) 

END  .=  VAL(RECDATA(20:21)) 

IF  (NAME .EQ. CATNAME)  GO  TO  3010 

OPEN ( UNI T  =  20, F ILE =NAME/  /  ' .LAR 1 ,STATUS=’OLD ' ,FORM= ' FORMATTED ' , 
*  ACCESS= ' D IRECT ' ) 

DO  3020  1  =  1  , END 

READ(20,H0W(10) ,REC=I )  RECDATA 
WHERE ( I )  =  RECDATA( 15:23) 

IF  (WHERE ( I ) .EQ. CATNAME)  THEN 
WRITE(22,310)  CATNAME, NAME 
RETURN 
END  IF 

3020  CONTINUE 

CLOSE ( UN  I T  =  20 ) 

GO  TO  3010 

DELETION  OF  CATEGORY 
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3030  CLOSE (UNIT=20) 

WRITE (22, 311)  CATNAME 
READ (21, 301)  ANS 
IF  ( ANS ( 1 : 1 )  .EQ  .  1 Y 1 )  THEN 
LTR  =  ' D  ' 

A  3  CATNAME 

CALL  BTREE(LTR,NINE,A,MAXLEN, I R EC, I  ERR) 

CL0SE(UNIT=1) 

0PEN(UNIT=1,FILE=A//' .KEY' , STATUS= ' OLD ' .FORM3 ' FORMATTED ' , 

*  ACCESS= 1 D IRECT 1 ) 

CLOSE (UN  I T  =  l, STATUS3' DELETE ' ) 

CL0SE(UNIT311) 

0PEN(UNIT  =  11  ,FILE=A// *  .DAR ' , STATUS  =  ' OLD ' , FORM3 1  FORMATTED ' , 

*  ACCESS3 1 DIRECt 1 ) 

CLOSE ( UN  I T-ll, STATUS  3 'DELETE'  ) 

CLOSE ( UN  I T  =  20 ) 

0PEN(UNIT320,FILE=A//'  .LAR’ .STATUS3 'OLD' , FORM3 ' FORMATTED  '  , 

*  ACCESS='DIRECT'  ) 

CLOSE (UN  I T  =  20, STATUS  = 'DELETE'  ) 

0PEN(UNIT=1,FILE3A//' .NOD' , STATUS3 ' UNKNOWN ' ) 

CLOSE (UN  I T  =  l, STATUS3' DELETE  '  ) 

0PEN(UNIT  =  1,FILE3A//'  .REC' , STATUS3' UNKNOWN  '  ) 

CLOSE ( UN  I T  =  l, STATUS  = 'DELETE' ) 

ELSE  IF  (ANS ( 1 : 1 )  . EQ  . ' N ' )  THEN 
WRITE(22,312)  CATNAME 
ELSE 

GO  TO  3030 
END  IF 
RETURN 
END 
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SUBROUTINE  ADDREC 
IMPLICIT  I NTEGERM  (A-Z) 

COMMON  / XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) , FLO ( 20 ) , T I TLE ( 20 ) , WHERE ( 20 ) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR, INA(20) , INB(20) , E  XA ( 20 ) ,EXB(20) ,HOW( 10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO, IERR ,NREF 

CHARACTER  LTR*1,H0W*6 , CAT  NAME *9 ,WHERE*9 , T I TLE*10 
CHARACTER  ANS*3  , A*20 , FLD* 1 00 , R ECDATA*2 56 

601  FORMAT ( A100 ) 

610  F0RMAT(/10X, 'ENTER  THE  DATA  FOR  FIELD',13,'  ( *  , A 10 , * ) ‘ ) 

611  FORMAT ( / 5 X , ' THE  FORMAT  FOR  A  DATE  IS  MM/DD/ YY YY ' // 

*15X,‘MM  =  INTEGER  FROM  1  TO  12  (MONTH)'/ 

*15X , ' DD  =  INTEGER  FROM  1  TO  31  (DAY)'/ 

*15X , ' YYYY  =  4  DIGITS  WHICH  SPECIFY  THE  YEAR'/ 

*/3X,  ' ENTER  THE  DATE ' ) 

612  FORMAT ( 13X , ' ( AT  MOST  ',13,'  CHARACTERS)') 

613  F0RMAT(//3X, ' ERROR  -  DATA  IS  REQUIRED  FOR  FIELD',13) 

614  F0RMAT(/3X, 'REQUEST  TO  ADD  DATA  IS  DENIED') 


DRIVER  FOR  ADDING  A  DATA  RECORD 


DO  6020  I =1 , NF I  ELD 
6010  WRITE (22, 610)  I , T I TLE ( I ) 

IF  ( TYPE (  I )  .EQ  .  3  )  THEN 
WR I TE ( 22 , 61 1 ) 

READ ( 2 1 ,601)  FLD(I) 

ELSE  IF  (TYPE ( I )  .EQ.4)  THEN 
IND  =  3 

CALL  TABL I  ST ( T I TLE ( I ) ,FLD( I ) , IND) 

IF  (FLD(I) .EQ.'  ' )  THEN 
WR  I  TE ( 22 , 614 ) 

RETURN 
END  IF 
ELSE 

K  =  EXB(I)  -  EXA(I)  +  1 
WRITE(22,612)  K 
READ (21,601)  FLD(I) 

END  IF 

IF  ((I.EQ.KEYFLD.OR.TYPE(I)  .GE.3)  .  AND  .  FLD ( I )  .EQ 
WRITE(6,613)  I 
GO  TO  6010 
END  IF 

6020  CONTINUE 
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CALL  VERIFY 
CALL  RECIN 
IF  (IERR.EQ.4)  THEN 
WR I TE ( 22 , 6 14  ) 
RETURN 
END  IF 
CALL  INSERT 
RETURN 
END 
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SUBROUTINE  VERIFY 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXX BOSS/ 

1  NFIELD.KEYFLD, CAT NAME ,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) , FLD ( 20 ) , T I TLE ( 20 ) .WHERE ( 20 ) , 

3  ONE, TWO, THREE, FOUR. FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) ,INB(2Q) ,EXA(20) ,EXB(20) ,H0W(10)  ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO, IERR.NREF 

CHARACTER  LTR*1 , H0W*6 , CATNAME *9 , WHERE *9 , T I TLE *10 
CHARACTER  ANS*3 ,A*20 , FLD*100 ,RECDATA*256 
C 

LOG  I C AL*1  TYPO 
C 

701  FORMAT ( A100 ) 

710' F0RMAT(/3X, 'ENTER  ZERO  IF  THE  DATA  IS  CORRECT,  OR  ENTER  THE' 
*/3X, 'NUMBER  OF  THE  FIELD  WITH  THE  INCORRECT  DATA') 

711  F0RMAT(/3X, 'ENTER  THE  CORRECT  DATA') 


VERIFY  A  DATA  RECORD 


7010  CALL  SHOWREC 
WR ITE ( 22 , 710  ) 

READ (21, 701)  ANS 

CALL  CHECK(ANS,N,NFIELD,TYPO) 

IF  (TYPO)  GO  TO  7010 
IF  (N.EQ.O)  RETURN 
IF  ( TYPE ( N )  .EQ  .4  )  THEN 
IND  =  3 

CALL  TAB LIST (TITLE(N) , FLD ( N ) ,IND) 
ELSE 

WR ITE ( 22 , 711 ) 

READ (21, 701)  FLD(N) 

END  IF 
GO  TO  7010 
END 
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SUBROUTINE  INSERT 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) , FLO (20) , T I TLE ( 20 ) , WHERE ( 20  ) , 

3  ONE .TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR* 1 , H0W*6 .CATNAME *9 ,  WHERE*9 , T I TLE*10 
CHARACTER  ANS*3 , A*20 ,FLD*100  ,RECDATA*256 
C 

401  FORMAT (215) 

410  F0RMAT(/3X, 'RECORD  NOT  INSERTED  INTO  THE  DATABASE 
*/3X ,  '  THE  KEY  IS  ALREADY  IN  USE') 

411  F0RMAT(/3X, 'CATEGORY  ',A9,'  CONTAINS  THE  MAXIMUM  NUMBER  OF' 
*/3X, 'RECORDS  ALLOWED  -  NO  ADDITIONAL  RECORDS  WILL  BE  ADDED') 

412  F0RMAT(/3X, 'WARNING  -  ',A9,'  NOW  CONTAI NS ' , 16 , '  RECORDS;' 

*/3X ,  'THE  MAXIMUM  NUMBER  IS  65530') 


INSERT  A  DATA  RECORD  INTO  CURRENT  CATEGORY 


CHECK  ON  NUMBER  OF  CURRENT  RECORDS 

READ(1,401,REC=1)  I,J 
K  =  J  -  I 

IF  (K.GT. 65530)  THEN 
WRITE (22,411 )  CATNAME 
RETURN 
END  IF 

LTR  =  'A' 

A  =  FLD(KEYFLD) 

CALL  BTREE(LTR,ONE,A,MAXLEN, IREC  ,  I  ERR) 

IF  (IREC. GE. 65475)  WR I TE ( 2 2 , 4 1 2  )  CATNAME, IREC 
IF  ( IERR.EQ  .6)  THEN 
WR I TE ( 22 , 4 10 ) 

RETURN 
END  IF 

DO  4010  I  =  1 , NF I  ELD 

RECDATA( INA(  I  )  :  I N  B (  I  ))  =  FLD(I) 

4010  CONTINUE 

WRITE(11,H0W(1) .REC-IREC)  RECDATA 

RETURN 

END 
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SUBROUTINE  GETREC 
C 

IMPLICIT  I NTEGER*4  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NF I  ELD, KEYFLD, CATNAME ,R£CDATA,A,NREF,L0NG(20), 

2  10(20) , ANS .TYPE ( 20 ) , FLD ( 20 ) , T I TLE ( 20 ) , WHERE ( 20 )  , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE,  TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) , E  XB ( 20 ) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB, 10, IERR.NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 , FLD* 100 ,RECDATA*256 
C 

601  FORMAT (A3 ) 

610  F0RMAT(/3X, 'SEE  NEXT  RECORD  OF  KEY  SEQUENCE?  (Y/N)') 

611  F0RMAT(/3X,  'THERE  ARE  NO  MORE  RECORDS  IN  ',A9) 


DRIVER  FOR  GETTING  A  DATA  RECORD 


CALL  FETCH 

IF  (IERR.EQ.4)  RETURN 
6010  CALL  RECOUT 
CALL  SHOWREC 
6020  WRITE (22,610) 

READ (21, 601)  ANS 
IF  (ANS (1:1)  .EQ.'Y' )  THEN 
LTR  =  'S' 

CALL  BTREE(LTR,ONE,A,MAXLEN, IREC, I  ERR) 
IF  (IERR.EQ.5)  THEN 

' WR I TE ( 22 , 61 1 )  CATNAME 
RETURN 
END  IF 

READ( 11 , HOW ( 1 )  ,REC  =  IREC)  RECDATA 
GO  TO  6010 

ELSE  IF  ( ANS (1:1)  .EQ  . ' N ' )  THEN 
RETURN 
ELSE 

GO  TO  6020 
END  IF 
RETURN 
END 
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SUBROUTINE  FETCH 
C 

IMPLICIT  INTEG£R*4  (A -1) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS,TYPE( 20) ,FLD( 20) .TITLE (20) .WHERE ( 20)  , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) ,H0W(10)  ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT,  NINE,  TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1,H0W*6 , CAT NAME *9 ,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 ,FLD*100 ,RECDATA*256 
C 

CHARACTER  $  YK  ‘2 ,  WHEN*10 
C 

701  FORMAT ( A 1 0  ) 

710  F0RMAT(/5X, 'THE  FORMAT  FOR  A  DATE  IS  MM/DD/YYYY  '  // 

*15X , 'MM  =  INTEGER  FROM  1  TO  12  (MONTH)'/ 

*15X,'DD  =  INTEGER  FROM  1  TO  31  (DAY)'/ 

*15X ,  ' YYYY  =  4  DIGITS  WHICH  SPECIFY  THE  YEAR'/ 

*/3X, 'ENTER  THE  DATE' ) 

711  F0RMAT(/3X,  'ENTER  THE  VALUE  OF  *  ,A10 ) 

712  FORMAT ( /3X , 'NO  RECORD  IN  ',A9,'  HAS  THE  REQUESTED  KEY') 


RETRIEVE  A  DATA  RECORD  FROM  CURRENT  CATEGORY 


K  =  TYPE (KE YFLD ) 

IF  (K.EQ.3)  THEN 
WRITE(22,710) 

READ (21, 701)  WHEN 
A  =  SYM(ENDATE(WHEN)) 

ELSE  IF  (K.EQ.4)  THEN 
IND  =  3 

CALL  TABLIST(TITLE(KEYFLD),A,IND) 

ELSE 

WR I TE ( 22 . 71 1 )  TITLE(KEYFLD) 

READ (21,701)  A 
IF  (K.EQ.5)  THEN 
LTR  =  ' G ' 

CALL  BTREE(LTR, IO(KEYFLD) ,A,MAXLEN, IREC,  I  ERR) 
IF  (IERR.EQ.4)  THEN 

WRITE(22,712)  WHERE ( KE YFLD  ) 

RETURN 
END  IF 

A  =  SYM(IREC) 

END  IF 
END  IF 
LTR  =■  *  G  * 
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CALL  BTREE(LTR,ONE,A,MAXLEN,IREC,IERR) 
IF  (IERR.EQ.4)  THEN 

WRITE (22, 712)  CATNAME 
ELSE 

REA0(11,H0W(1)  ,REC  =  IREC)  RECDATA 
END  IF 
RETURN 
END 
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SUBROUTINE  DELREC 
C 

IMPLICIT  I NTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NF  1  ELD, KEYFLD, CATNAME , RECDATA , A , NREF , LONG ( 20 ) , 

2  10(20) ,ANS,TYPE (20) , FLO (20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, F I VE ,S IX, SEVEN, EIGHT, NINE , TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA, INB,EXA,EXB, 10, 1  ERR, NREF 

CHARACTER  LTR*1,H0W*6 .CAT NAME *9 ,WHERE*9,TITLE*10 
CHARACTER  ANS*3,A*20,FLD*100,RECDATA*256 
C 

CHARACTER  NAME *9 ,C0PYCAT*9,UNIQUE*20 
C 

302  FORMAT ( A10 ) 

310  F0RMAT(/3X, 'ENTER  FULL  KEY  VALUE  OF  *,A10) 

311  FORMAT ( /3X , 1  NO  RECORD  IN  ',A9,'  HAS  THE  REQUESTED  KEY') 

312  F0RMAT(/3X, ' RECORD  DELETION  REQUEST  CANCELLED') 

313  FORMAT ( / 3 X , '  REQUEST  DENIED  -  REFERENCED  IN  A  DATA  RECORD'/ 
*3X, 'CONTAINED  IN  CATEGORY  ',A9) 

314  FORMAT ( / 3 X , 'DO  YOU  WISH  TO  DELETE  THIS  RECORD?  ( Y/N ) ' ) 

315  F0RMAT(/3X, 'PRESS  THE  "RETURN"  KEY  TO  CONTINUE') 

316  F0RMAT(/3X, 'KEYSTROKE  ERROR  -  TRY  AGAIN') 


DRIVER  FOR  DELETING  A  DATA  RECORD 


COPYCAT  =  CATNAME 
NF  =  NF I  ELD 

WRITE(22,310)  TITLE(KEYFLD) 

RE AD (21, 302)  UNIQUE 
LTR  =  'G* 

A  =  UNIQUE 

CALL  BTREE(LTR,ONE,A,MAXLEN,KEYREC,IERR) 
IF  (IERR.EQ.4)  THEN 

WR I TE ( 22 , 31 1 )  CATNAME 
WRITE(22,312) 

RETURN 
END  IF 

CHECK  FOR  RELATED  RECORDS 


LTR  =  ' F  ' 

3010  CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,IERR) 
IF  (IERR.EQ.5)  GO  TO  3040 
LTR  =  'S' 

READ(19,H0W(9)  ,REC  =  IREC)  RECOATA 
CATNAME  *  RECDATA(  1:9) 
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NFIELO  =  VAL(RECDATA(20:21)) 

IF  (CATNAME .EQ. COPYCAT)  60  TO  3010 
CLOSE (UNIT  =  20 ) 

0PEN(UNIT=20,FILE=CATNAME// '  .LAR* , STATUS  =  ' OLD  '  , 
*  FORM =' FORMATTED'  , ACC E SS  =  ' D  I RECT  '  ) 

DO  3030  1=1, NFIELO 

READ(20,H0W(10)  ,REC  =  I  )  RECDATA 
IF  ( RECDATA ( 15:23) .EQ. COPYCAT)  THEN 
CALL  OPENCAT 
LTR  =  '  F  * 

3020  CALL  BTREE(LTR,ONE,A,MAXLEN,IREC, IERR) 

IF  ( IERR .EQ.4  .OR  .  IERR  .  EQ  .  5 )  60  TO  3030 
LTR  =  'S' 

READ(11,H0W(1)  ,REC  =  IREC)  RECDATA 
K  =  VAL (RECDATA( INA( I ) : INB( I ) )  ) 

IF  (K.EQ  .KEYREC  )  THEN 
WR I TE { 22 , 3 1 3  )  CATNAME 
CALL  RECOUT 
CALL  SHOWREC 
WRITE(22,315) 

RE AD (21, 302)  ANS 
CATNAME  =  COPYCAT 
NF I  ELD  =  NF 
CALL  OPENCAT 
RETURN 
END  IF 
60  TO  3020 
END  IF 

3030  CONTINUE 
LTR  =  'S' 

60  TO  3010 

DELETION  OF  RECORD 

3040  CATNAME  =  COPYCAT 
NFIELO  =  NF 
CALL  OPENCAT 

READ (11, HOW ( 1 )  ,REC  =  KE YREC )  RECDATA 
CALL  RECOUT 
CALL  SHOWREC 
3050  WR  I TE ( 22 , 3 14  ) 

READ (21, 302 )  ANS 
IF  (ANS (1:1)  . EQ  . ' Y  * )  THEN 
CALL  RECIN 
LTR  =  *  D  * 

A  =  FLD(KEYFLD) 

CALL  BTREE(LTR,ONE,A,MAXLEN,IREC,  IERR) 

ELSE  IF  (ANS (1:1)  .EQ  . 1 N ' )  THEN 
WR I TE ( 22 , 312  ) 

ELSE 

WRITE(22,316) 

60  TO  3050 
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END  IF 
RETURN 
END 
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SUBROUTINE  MODREC 
C 

IMPLICIT  I NTEGERM  (A-Z) 

C 

COMMON  / XXXBOSS/ 

1  NFIELD.KEYFLD, CATNAME, RECDATA, A, NREF,L0NG(20), 

2  10(20) ,ANS,TYPE( 20) . FLD ( 20) .TITLE (20)  .WHERE (20), 

3  ONE, TWO, THREE .FOUR, FIVE, SIX, SEVEN, EIGHT,  NINE, TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW ( 10 )  ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN,  EIGHT,  NINE,  TEN 
BYTE  INA, INB ,EXA,EXB , 10, I  ERR  ,NREF 

CHARACTER  LTR *1 , H0W*6 , CATNAME *9 , WHER E*9 , T I TLE*10 
CHARACTER  ANS*3 , A* 20 , FLO *100 ,R EC  DATA* 2 56 
C 

CHARACTER  NAME*9 , OLDKE Y *20 
LOG  I  CAL  *  1  NOTE 
C 

401  FORMAT ( A3 ) 

410  F0RMAT(/3X, 'APPROPRIATE  CHANGES  IN  ' ,A9,'  WILL  BE  MADE') 

411  FORMAT ( / 3 X , 1  DO  YOU  WISH  TO  MAKE  THE  MODIFICATION?  (Y/N)') 

412  F0RMAT(/3X, 'REQUEST  TO  MODIFY  DATA  DENIED') 

413  FORMAT( / 3X , ' REQUEST  TO  MODIFY  DATA  CANCELLED') 


DRIVER  FOR  MODIFYING  A  DATA  RECORD 


NOTE  =  .FALSE. 

CALL  FETCH 

IF  (IERR.EQ.4)  RETURN 

OLDKE Y  =  RECDATA( INA(KEYFLD)  :  INB(KEYFLD)  ) 

CALL  RECOUT 
CALL  VERIFY 

CHECK  FOR  CATEGORIES  AFFECTED  BY  THE  MODIFICATION 
LTR  =  ' F  ' 

4010  CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,IERR) 

IF  (IERR.EQ.5)  GO  TO  4030 
LTR  -  'S' 

READ(19,H0W(9)  ,REC  =  IREC)  RECDATA 
NAME  »  RECDATA( 1:9) 

END  =  VAL(RECDATA(20:21)  ) 

IF  (NAME  .EQ. CATNAME)  GO  TO  4010 
CLOSE ( UN  I T  =  20  ) 

0PEN(UNIT  =  20,FILE=NAME//'  .LAR' ,  STATUS  =  ' OLD  '  ,F0RM= ' FORMATTED '  , 
*  ACCESS= 'DIRECT') 

DO  4020  1=1, END 

READ(20,H0W( 10) ,REC=I )  RECDATA 
WHERE ( I )  =  RECDATA(15:23) 

IF  (WHERE ( I ) .EQ .CATNAME )  THEN 
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WRITE (22,410)  NAME 
NOTE  =  .TRUE. 

GO  TO  4010 
END  IF 

4020  CONTINUE 

GO  TO  4010 

MODIFICATION  OF  RECORD 

4030  CLOSE ( UN  I T  =  20  ) 

IF  (NOTE)  THEN 
WR I TE ( 22 , 41 1 ) 

READ (21, 401)  ANS 
ELSE 

ANS  =  1 Y  ' 

END  IF 

IF  ( ANS ( 1 : 1 )  .EQ.'Y'  )  THEN 
CALL  RECIN 
IF  (IERR.EQ.4)  THEN 
WRITE(22,412) 

RETURN 
END  IF 
LTR  =  ' D  ' 

CALL  B TREE (LTR, ONE, OLDKE Y .MAXLEN, IREC,  I  ERR) 
CALL  INSERT 

ELSE  IF  ( ANS (1:1)  .EQ.'N'  )  THEN 
WRITE(22,413) 

ELSE 

GO  TO  4030 
END  IT 
RETURN 
END 
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SUBROUTINE  TABMENU 
IMPLICIT  I NTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFIELD, KEYFLD.CATN AM E, RECDATA, A, NREF,L0NG(20) , 

2  10(20) ,ANS,TYPE (20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO,  THREE, FOUR, FIVE, SIX, SEVEN. EIGHT, NINE, TEN. 

4  I  ERR , I NA ( 20 ) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE,  TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA.INB ,EXA,EXB,IO, I  ERR ,NREF 

CHARACTER  LTR*1 , HOW* 6  , C ATNAME *9 , WHER E*9 , T I TL E *1 0 
CHARACTER  ANS*3 , A*20 , FLO* 1 00 , R EC  DAT A*2 56 

CHARACTER  FLDNAME*10,FLDVAL*10 
L0GICAL*1  TYPO 

301  FORMAT ( A3  ) 

310  F0RMAT(/15X, 'FIELD  NAMES  IN  "TABLE"'/ 

*/10X, ' NUMBER '  , 10X , 1  NAME  1  /  ) 

HI  F0RMAT(11X,I3,12X,A10) 

312  F0RMAT(/3X, ‘ENTER  THE  APPROPRIATE  NUMBER') 

313  F ORMAT ( 3 X , ’ OR  ENTER  ZERO  TO  SEE  MORE  LIST') 

314  FORMAT ( 3  X ,' OR  ENTER  ZERO  TO  RETURN  TO  PREVIOUS  MENU') 

315  FORMAT ( / 10X , 'NUMBER1  , 10 X  ,  ' ACT  I  ON ' / / 

*  1 2  X  ,  ' 1 ' ,13X, 'MODIFY  DATA'/ 

*12X , 1 2 '  ,13X,  ‘DELETE  DATA'/ 

*12X, '3' ,13X, 'LIST  CURRENT  FIELD  VALUES'/ 

*  1 2  X  ,  ' 4 '  ,  1 3  X  ,  ' ADD  DATA'/ 

*12X, '5'  ,13X, 'RETURN  TO  PREVIOUS  MENU') 


DRIVER  FOR  "TABLE"  REQUEST 


LIST  ALL  "TABLE"  FIELDS  OF  ALL  CATEGORIES 

300  WR I TE ( 22 , 910  ) 

KOUNT  =  0 
LTR  =  ' F  * 

305  CALL  BTREE(LTR,NINE,A,MAXLEN,  IREC,  IERR) 

IF  (IERR. EQ. 4. OR. IERR. EQ. 5)  GO  TO  9020 
LTR  =  'S' 

READ(19,H0W(9),REC=IREC)  RECDATA 
CATNAME  =  RECDATA(  1:9) 

NFIELD  =  VAL(RECDATA(20: 21 ) ) 

CLOSE ( UN IT=20 ) 

0PEN(UNIT=20,FILE=CATNAME// '  .LAR’ , STATUS= ' OLD ' , 
*  FORM= ' FORMATTED'  ,  ACCE SS  =  ' D I RECT ' ) 

DO  9010  1  =  1, NFIELD 

READ(20,H0W( 10) ,REC=I )  RECDATA 
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M  =  N  +  1 

N  =  N  +  WIDTH(J) 

KM  =  16 

KN  =  KM  +  WIDTH(J) 

DO  5065  K  =  1 ,  NCOL 

L I NE ( KM : KN )  =  COL ( K ) ( M : N  ) 
KM  =  KM  +  TAB 

KN  =  KM  +  WIDTH(J) 

5065  CONTINUE 

WRITE(24,514)  LINE 
5070  CONTINUE 

LINE  =  '  ' 

WR I TE ( 24 , 514  )  LINE 
IF  (INU.EQ.O)  GO  TO  5040 
CLOSE ( UNIT  =  23 ) 

CL0SE(UNIT=24) 

RETURN 

END 
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ELSE 

MUCH  =  0 

.020  MUCH  =  MUCH  +  1 
WRITE(22,512) 

CALL  FL0LIST(L1NK(MUCH) ) 

WRITE(22,513) 

READ (21, 502)  ANS 
IF  ( ANS ( 1 : 1 )  ,EQ  . 1 Y ' )  GO  TO  5020 
END  IF 

COMPUTE  FORMAT  PARAMETERS  OF  OUTPUT  FILE 

DO  5030  1=1  , MUCH 
J  =  LINK(I) 

IF  (TYPE(J)  .EQ.3.0R.TYPE(J) .EQ.4)  THEN 
WIDTH(J)  =  10 
ELSE 

WIDTH(J)  =  EXB(J)  -  EXA(J)  +  1 
END  IF 

>030  CONTINUE 
TAB  =  0 

DO  5035  1=1, MUCH 

TAB  =  MAXO(TAB,WIDTH(LINK( I ) ) ) 

>035  CONTINUE 

TAB  =  TAB  +  5 

NCOL  =  MIN0(115/TAB,8) 

WRITE  SELECTED  RECORD  FIELDS 

REWIND (UNIT=23) 

0PEN(UNIT  =  24,FILE=CATNAME//'  .OUT'  , STATUS  =  ' NEW ' ) 
>040  DO  5045  K=1,NC0L 
COL(K)  =  '  ' 

•045  CONTINUE 

DO  5055  K=1 , NCOL 

READ(23,501,END=5060,IOSTAT=1ND)  1REC 
READ(11,H0W(1) ,REC=IREC)  RECDATA 
CALL  RECO'UT 
M  =  0 
N  =  0 

DO  5050  1*1, MUCH 
J  =  LINK(I) 

M  =  N  +  1 
N  -  N  +  WIDTH(J) 

COL ( K ) ( M : N )  =  FLD(O) 

>050  CONTINUE 
>055  CONTINUE 
>060  M  =  0 
N  =  0 

DO  5070  1=1, MUCH 
J  =  LINK(I) 

LINE  =  TITLE(J) 
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SUBROUTINE  OUTPUT 
C 

IMPLICIT  INTEGERM  ( A-Z ) 

C 

COMMON  /XXXBOSS/ 

1  NF  I  ELD.KEYFLD, CATNAME ,RECDATA,A,NREF,L0NG(2Q)  , 

2  10(20) , ANS, TYPE (20) ,FLD( 20) , T I TLE ( 20 ) , WHERE ( 20 ) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  I  ERR, INA(20) , INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE .FOUR, FI VE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA, INB.EXA.EXB, 10 , 1  ERR , NREF 

CHARACTER  LTR*1 ,  H0W*6  , C ATNAME *9 , WHER E*9 , T I TLE* 10 
CHARACTER  ANS*  3 , A*20 ,FLD*100 ,RECDATA*256 
C 

INTEGER  W I DTH ( 20  ) 

BYTE  L I NK ( 20 ) 

CHARACTER  L I NE* 1 32 , COL ( 8 ) *2 56 
C 

501  FORMAT (15) 

502  FORMAT ( A3 ) 

510  FORMAT ( //3X , 'DO  YOU  WISH  TO  CREATE  THE  OUTPUT  FILE  ' ,A12 
*/3X ,  1  CONTAINING  ALL  THE  RECORDS  FOUND?  (Y/N)') 

511  FORMAT (/3X, ' DO  YOU  WISH  TO  WRITE  ALL  FIELDS?  (Y/N)') 

512  F0RMAT(/3X, ‘SELECT  A  FIELD  TO  BE  WRITTEN'/) 

513  FORMAT (/3X, ' DO  YOU  WISH  TO  WRITE  AN  ADDITIONAL  FIELD?  ( Y/N ) * ) 

514  FORMAT ( '  ' ,A132) 


WRITE  A  SET  OF  RECORDS  ON  AN  OUTPUT  FILE 


SELECT  RECORD  FIELDS  TO  BE  WRITTEN 
J  =  9 

DO  WHILE  ( CATNAME ( J : J ) .EQ . '  ') 

J  =  J  -  1 
END  DO 

A  =  CATNAME (1:0)//' .OUT' 

WRITE(22,510)  A 
RE AD ( 2 1 , 502 )  ANS 
IF  (ANS (1:1) .EQ.'N* )  THEN 
CL0SE(UNIT=23) 

RETURN 
END  IF 

WR I TE ( 22 , 51 1 ) 

RE AD (21, 502)  ANS 
IF  ( ANS (1:1)  .EQ.'Y*  )  THEN 
MUCH  =  NF I  ELD 
DO  5015  1  =  1, MUCH 
LINK(I)  =  I 
5015  CONTINUE 
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SUBROUTINE  CATLIST 
IMPLICIT  INTEGER*4  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFIELD.KEYFLD , CAT NAME ,RECDATA,A,NREF,L0NG(20), 

2  10(20)  ,ANS, TYPE (20) , FLO (20) , T I TLE ( 20 ) , WHERE ( 20 ) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) , INB(20) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN,  EIGHT,  NINE,  TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1 , H0W*6 ,CATNAME*9  , WHER E*9 , T I TLE*10 
CHARACTER  ANS*3 , A*20 , FLO* 100 , RECDATA*256 

701  FORMAT (15) 

710  FORMAT (  /3X , I  5 , '  RECORDS  WERE  FOUND') 


WRITE  NUMBER  OF  EVERY  RECORD  OF  CURRENT 
CATEGORY  ON  A  SCRATCH  FILE 


0PEN(UNIT=23,FILE='RECN0S' .STATUS- ' SCRATCH ' ) 
KOUNT  =  0 
LTR  =  1 F  * 

7010  CALL  BTREE(LTR,ONE,A,MAXLEN,IREC,IERR) 

IF  (IERR.EQ.4.0R.IERR.EQ.5)  GO  TO  7020 
KOUNT  =  KOUNT  +  1 
LTR  =  'S' 

WRITE(23,701)  IREC 
GO  TO  7010 

7020  WRITE(22,710)  KOUNT 
CALL  OUTPUT 
RETURN 
END 
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SO  =  A.GE.BD(K) 

END  IF 
ELSE 

IF  (TYPE(J)  .EQ.3)  THEN 
X  =  ENOATE (A) 

Y  =  VAL ( BD ( K  ) ) 

ELSE  IF  (TYPE(J)  .  E  Q  .  2  )  THEN 
X  =  CONVERT (A) 

Y  =  CONVERT ( BD { K ) ) 

END  IF 


IF  (L.EQ 

.1)  THEN 

SO  = 

X.EQ.Y 

ELSE  IF 

(L.EQ. 2) 

THEN 

SO  = 

X . NE  .  Y 

ELSE  IF 

(L.EQ. 3) 

THEN 

SO  = 

X.LT.Y 

ELSE  IF 

(L.EQ. 4) 

THEN 

SO  = 

X.GT.Y 

ELSE  IF 

(L.EQ. 5) 

THEN 

SO  = 

X  .LE  .Y 

ELSE  IF 

(L.EQ. 6) 

THEN 

SO  = 

X.GE  .Y 

END  IF 

END  IF 

IF  ( .NOT. SO)  GO  TO  8030 
8045  CONTINUE 

MANY  =  MANY  +  1 
WR I TE ( 2 3 , 802  )  IREC 
GO  TO  8030 

OPTION  TO  WRITE  ADMISSIBLE  RECORDS  TO  A  FILE 

8050  WRITE(22,815)  MANY 
CALL  OUTPUT 
RETURN 
END 
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CALL  FLDLIST ( I ) 

LIST(KOUNT)  =  I 
8015  WRITE ( 22 »81 1 ) 

REA0{21 ,801 )  ANS 

CALL  CHECK(ANS,LINK(KOUNT)  ,  S I  X , T YPO ) 

IF  (TYPO)  GO  TO  8015 
J  =  TYPE  ( I  ) 

IF  (J.EQ.3)  THEN 
WRITE(22,812) 

READ (21,801)  WHEN 
BD(KOUNT)  =  SYM ( ENDATE ( WHEN ) ) 

ELSE 

WR1TE(22,813) 

READ ( 2 1 , 801 )  BD(KOUNT) 

END  IF 

8020  WR I TE ( 22 , 814  ) 

READ ( 2 1 , 801 )  ANS 
IF  ( ANS (1:1)  .EQ.'Y')  THEN 
GO  TO  8010 

ELSE  IF  (ANS(1: 1)  -  EQ-'N'  )  THEN 
GO  TO  8025 
ELSE 

WR I TE ( 22 , 816 ) 

GO  TO  8020 
END  IF 

EXAMINE  EVERY  RECORD  IN  CATEGORY 

8025  0PEN(UNIT=23,FILE  =  'RECN0S' .STATUS* ' SCRATCH  '  ) 
MANY  =  0 
LTR  =  1 F  ' 

8030  CALL  BTREE(LTR,ONE,A,MAXLEN,IREC,IERR) 

IF  ( IERR.EQ.4.0R.IERR.EQ.5)  GO  TO  8050 
LTR  *  'S' 

READ(11,H0W(1)  ,REC  =  IREC)  RECDATA 
CALL  RECOUT 
DO  8045  K= 1 , KOUNT 
L  *  LINK(K) 

J  *  LIST(K) 

A  =  FLD(J) 

IF  (TYPE(J)  .EQ.l.OR.TYPE(J)  .GE.4)  THEN 
IF  (L.EQ.l)  THEN 


SO 

= 

A.EQ.BD(K) 

ELSE 

IF 

(L.EQ.2)  THEN 

SO 

= 

A.NE .BD ( K ) 

ELSE 

IF 

(L.EQ.3)  THEN 

SO 

= 

A  .  LT  .  BD ( K  ) 

ELSE 

IF 

(L.EQ.4)  THEN 

SO 

= 

A.GT  . BD ( K ) 

ELSE 

IF 

(L.EQ.5)  THEN 

SO 

= 

A.LE  .BD ( K ) 

ELSE 

IF 

(L.EQ.6)  THEN 
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SUBROUTINE  QUERY 
IMPLICIT  I NTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(2Q), 

2  10(20) ,ANS, TYPE (20) , FLO (20) .TITLE (20) .WHERE ( 20 ) . 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA, INB,EXA,EXB, 10, 1  ERR  ,NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*I0 
CHARACTER  ANS *3 , A*20 , FLD* 1 00 , R ECDATA*256 

BYTE  LINK (20) ,LIST(20) 

REAL  X  Y 

CHARACTER  SYM*2 ,WHEN*10 ,BD( 20) *10 
L0GICAL*1  SO, TYPO 

801  FORMAT ( A20 ) 

802  FORMAT (15) 

810  F0RMAT(//10X, ' SELECT  QUERY  FIELD') 

811  FORMAT ( / 1  OX , 'NUMBER' ,10X, 'RELATION'// 

*13X , ' 1 ' ,27X, 'EQUAL'/ 

*13X, ‘2* ,27X, 'NOT  EQUAL'/ 

*13X, '3' ,27X, 'STRICTLY  LESS  THAN'/ 

*13X, '4' ,27X, 'STRICTLY  GREATER  THAN'/ 

*13X, '5' ,27X, 'LESS  THAN  OR  EQUAL'/ 

*13X, '6* ,27X, 'GREATER  THAN  OR  EQUAL'/ 

*/ 3X ,' ENTER  APPROPRIATE  NUMBER') 

812  FORMAT ( /5X , ' THE  FORMAT  FOR  A  DATE  IS  MM/DD/ YYY Y  ' // 

*1 5X , 1  MM  =  INTEGER  FROM  1  TO  12  (MONTH)'/ 

*15X , ' DD  =  INTEGER  FROM  1  TO  31  (DAY)'/ 

*15X , ' YYY Y  =  4  DIGITS  WHICH  SPECIFY  THE  YEAR'/ 

*/3X, 'ENTER  THE  DATE'  ) 

813  F0RMAT(/3X, 'ENTER  THE  BOUND  (NO  MORE  THAN  10  CHARACTERS)') 

814  FORMAT ( /3X , ' DO  YOU  WISH  TO  SPECIFY  MORE  RELATIONS?  (Y/N)’) 

815  FORMAT ( /3X , 16 , '  RECORDS  WERE  FOUND') 

816  F0RMAT(/3X, ' KEYSTROKE  ERROR  -  TRY  AGAIN') 


WRITE  NUMBERS  OF  ALL  DATA  RECORDS  SATISFYING  A 
SET  OF  SPECIFIED  CONDITIONS  ON  A  SCRATCH  FILE 


SELECT  QUERY  FIELDS  AND  SPECIFY  CONDITIONS 

KOUNT  =  0 
8010  KOUNT  =  KOUNT  +  1 

IF  (KOUNT. EQ. 20)  GO  TO  8025 
WR I TE (22 ,810 ) 
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SUBROUTINE  SHOWREC 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20)  , 

2  10(20) ,ANS,TYPE( 20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE. TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) , E  XB ( 20 ) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB, 10, IERR.NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 ,FLD*100 ,RECDATA*256 
C 

801  FORMAT (A3) 

810  FORMAT ( / ) 

811  FORMAT ( 3 X, 1  FIELD ' , 13 , 3X , A10 , 5X ,A100 ) 

812  FORMAT ( /3X , 1  DO  YOU  WISH  TO  SEE  MORE  LIST?  (Y/N)') 


DISPLAY  A  RECORD  ON  THE  SCREEN 


WR I TE ( 22 , 810  ) 

DO  8010  I  =  1 , NF I  ELD 

WR I TE ( 22 , 81 1 )  I,TITLE(I),FLD(I) 
IF  (MOD (1,20)  .EQ  .0 )  THEN 
WRITE(22,812) 

RE AD ( 2 1 , 801 )  ANS 
'IF  ( ANS (1:1)  .EQ.'N' )  RETURN 
END  IF 

8010  CONTINUE 
RETURN 
END 
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SUBROUTINE  RECOUT 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD.KEYFLD, CAT  NAME, RECDATA, A, NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) , FLO (20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  I  ERR, I NA ( 20 ) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 ,FLD*100 ,RECDATA*256 
C 

CHARACTER  DEDATE*10 


TRANSFORM  A  RECORD  FROM  INTERNAL  TO  EXTERNAL  FORMAT 


DO  4010  I  =  1 , NF I  ELD 

FLO ( I )  =  RECDATA( I NA( I ) : I NB ( I ) ) 

4010  CONTINUE 

DO  4030  I =1 , NF  I  ELD 

IF  (TYPE(I)  .LE.2)  GO  TO  4030 
K  =  VAL ( FLO ( I ) ) 

IF  (TYPE(I)  .EQ.3)  THEN 
FLD(I)  =  OEDATE(K) 

ELSE  IF  (TYPE (  I )  ,EQ  .4 )  THEN 
LTR  =  1 F  ' 

A  =  TITLE(I) 

4020  CALL  BTREE(LTR,TEN,A,MAXLEN,IREC,IERR) 

LTR  =  'S' 

IF  ( IREC.NE.K)  GO  TO  4020 
FLD(I)  =  A( 1 1 : 20 ) 

ELSE  IF  ( TYPE ( I )  .EQ  .  5  )  THEN 
LDU  =  10(1)  +  10 

READ ( LDU , HOW (10(1 ) ) ,REC=K)  RECDATA 
FLD(I)  =  RECDATA (EXA( I ) : EXB(  I ) ) 

END  IF 

4030  CONTINUE 
RETURN 
END 
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SUBROUTINE  RECIN 
C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXX BOSS/ 

1  NF I  ELD, KEY  FLO, CAT NAME ,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) , FLO ( 20 )  ,  T I TLE ( 20 )  ,  WHERE ( 20  )  , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,lO,IERR,NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 ,FLD*100 ,RECDATA*256 
C 

CHARACTER  SYM*2 
C 

310  F0RMAT(/3X, 'KEY  CANNOT  BE  FOUND  IN  *  ,A9) 


TRANSFORM  A  RECORD  FROM  EXTERNAL  TO  INTERNAL  FORMAT 


IERR  =  0 

DO  3010  I =1 , NF I  ELD 

IF  (TYPE ( I )  .EQ.3)  THEN 

FLD(I)  =  SYM(ENDATE(FLD(  I ))  ) 

ELSE  IF  (TYPE(l)  .EQ.4)  THEN 
LTR  *  ' G ' 

A  =  T I TLE ( I  )//FLD  ( I ) 

CALL  BTREE(LTR,TEN,A,MAXLEN,IREC,  IERR) 
FLD(I)  =  SYM(IREC) 

ELSE  IF  (TYPE (I)  .EQ.5)  THEN 
LTR  =  ' G ' 

A  =  FLD(I) 

CALL  BTREE(LTR,IO(I),A,MAXLEN,IREC,IERR) 
FLD(I)  =  SYM(IREC) 

END  IF 

IF  (IERR. EQ.4)  THEN 

WR  I  TE ( 22 , 3 10 )  WHERE ( I ) 

RETURN 
END  IF 

3010  CONTINUE 
RETURN 
END 
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SUBROUTINE  FLDLIST(N) 

C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS,TYPE( 20) , FLO (20) .TITLE (20)  .WHERE  (  20  )  , 

3  ONE, TWO, THREE .FOUR, FIVE, SIX, SEVEN, EIGHT, NINE .TEN, 

4  IERR , INA(20) . INB( 20) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT,  NINE,  TEN 
BYTE  INA,INB,EXA,EXB, 10, IERR.NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 ,A*20 , FLD*100 ,RECDATA*256 
C 

L0GICAL*1  TYPO 
C 

501  FORMAT (A3) 

510  F0RMAT(/8X, 'LIST  OF  FIELDS  OF  '  , A9/ ) 

511  FORMAT (5X, 'FIELD' ,I3,10X,A10) 

512  F0RMAT(/3X, 'ENTER  THE  APPROPRIATE  FIELD  NUMBER') 


LIST  FIELD  NAMES  OF  CURRENT  CATEGORY 
AND  SELECT  A  FIELD 


5010  WRITE(22,51Q)  CATNAME 
DO  5020  I =1 , NF IELD 
WRITE (22 , 51 1 )  I.TITLE(I) 

5020  CONTINUE 

WRI  TE  (-2 2 , 512  ) 

READ (21, 501)  ANS 

CALL  CHECK(ANS,N,NFIELD,TYPO) 

IF  (TYPO)  GO  TO  5010 

RETURN 

END 
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SUBROUTINE  REVIEW 
IMPLICIT  INTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFI£LD,KEYFLD , CAT NAME ,RECDATA,A,NREF,L0NG(20) , 

2  10(20)  ,ANS,TYPE(20) ,  FLD ( 20 )  ,  T I TLE ( 20 ) , WHERE ( 20 ) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR,INA(20) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,  INB ,EXA,EXB , IO,IERR,NREF 

CHARACTER  LTR*1,H0W*6 ,CATNAME*9 ,WHERE*9,TITLE*10 
CHARACTER  ANS*3 , A* 20 , FLD* 1 00 , RECDATA*256 

LOG ICAL*1  NEW 

501  FORMAT (A3 ) 

510  F0RMAT(/3X, 'SEE  PARAMETERS  OF  ANOTHER  FIELD?  (Y/N)') 


SELECT  A  FIELD  AND  REVIEW  ITS  PARAMETERS 


5010  CALL  FLDLIST(N) 

CALL  V I EWSPEC ( N , NEW ) 
WRITE(22,510) 

READ (21, 501)  ANS 
IF  ( ANS (1:1) .EQ.'Y') 
RETURN 
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SUBROUTINE  MODWORD 
IMPLICIT  I  NTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATN AM E, RECDATA, A, NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) ,FLD( 20)  .TITLE (20)  .WHERE (20)  , 

3  ONE .TWO, THREE .FOUR .FIVE  ,S  IX, SEVEN, EIGHT, NINE .TEN, 

4  IERR,INA(20) ,INB(20) , E  XA ( 20 ) ,EXB(20) .HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE,  TEN 
BYTE  INA,  INB.EXA.EXB , 10, 1  ERR  ,NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*I0 
CHARACTER  ANS*3 , A* 20 , FLD *  1 00  , R ECDATA*2 56 

601  FORMAT ( A10 ) 

610  F0RMAT(/3X, ' ENTER  NEW  CATEGORY  PASSWORD') 


MODIFY  PASSWORD  OF  CURRENT  CATEGORY 


A  =  CATNAME 

CALL  BTREE(LTR,NINE,A,MAXLEN, IREC.IERR) 
READ(19,H0W(9) ,REC=IREC)  RECDATA 
WRITE(22,610) 

READ (21,601)  RECDATA( 10:19) 
WRITE(19,H0W(9) ,REC=IREC)  RECDATA 
RETURN 
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TYPE ( I )  =  V  AL (RECDATA( 13: 14) ) 

IF  (TYPE ( I )  .EQ.4)  THEN 
KOUNT  =  KOUNT  +  1 
FLD(KOUNT)  =  RECDATA ( 1:10) 

WR I TE ( 22 , 9 1 1 )  KOUNT  ,FLD(KOUNT) 
IF  (M0D(K0UNT,20)  .EQ.O)  THEN 
9008  WRITE(22,912) 

WR I TE ( 22 , 91 3  ) 

READ (21,901)  ANS 
CALL  CHECK(ANS,N, KOUNT, TYPO) 
IF  (TYPO)  GO  TO  9008 
IF  (N.EQ.O)  THEN 
KOUNT  =  0 
WR I TE ( 2  2 ,910) 

ELSE 

GO  TO  9025 
END  IF 
END  IF 
END  IF 

9010  CONTINUE 

GO  TO  9005 

SELECT  AND  EXECTUE  "TABLE"  REQUEST 

9020  WRITE(22,912) 

WRITE (22, 914) 

READ ( 2 1 , 90 1 )  ANS 

CALL  CHECK(ANS,N, KOUNT, TYPO) 

IF  (TYPO)  GO  TO  9020 
IF  (N.EQ.O)  RETURN 
9025  FLDNAME  =  FLD(N) 

9030  WRITE(22,915) 

WRITE(22,912) 

READ (21,901)  ANS 

CALL  CHECK(ANS,NUM, FIVE, TYPO) 

IF  (TYPO)  GO  TO  9030 
IF  (NUM.LE.3)  THEN 

9040  CALL  TABLIST(FLDNAME,FLDVAl.  ,NUM) 

IF  (NUM.LE.2)  THEN 

IF  ( FLDVAL  . E Q  . '  ' )  GO  TO  9030 
CALL  TABDEL(FLDNAME , FLDVAL, NUM) 
IF  (NUM.EQ.l)  THEN 

CALL  TABADD ( FLDNAME  ) 

GO  TO  9040 
END  IF 
END  IF 

ELSE  IF  (NUM. EQ.4)  THEN 
CALL  TABADD ( FLDNAME ) 

ELSE  IF  (NUM.EQ.5)  THEN 
GO  TO  9000 
END  IF 
GO  TO  9030 
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SUBROUTINE  TABAOD ( FLDNAME  ) 

IMPLICIT  I NTEGERM  (A-Z) 

COMMON  /XXXBOSS/ 

1  NF I  ELD , KE Y FLO , CAT NAME ,RECDATA,A,NREF,L0NG(20)  , 

2  10(20) ,ANS, TYPE (20) ,FLD( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE,  TEN, 

4  IERR,INA(20) ,INB(20) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR*1 , H0W*6 .CAT NAME *9 ,WHERE*9 ,T ITLE*10 
CHARACTER  ANS*3,.V-20,FLD*100,RECDATA*256 

CHARACTER  FLDNAME*10,FLDVAL*10 

801  FORMAT ( A10 ) 

810  F0RMAT(/3X, ' ENTER  FIELD  VALUE'/ 

*3X , ‘ ( AT  MOST  10  CHARACTERS)') 


ADD  A  RECORD  TO  CATEGORY  "TABLE" 


WRITE(22,810) 

READ ( 2 1 , 801 )  FLDVAL 
A ( 1 : 1 0 )  =  FLDNAME 
A( 1 1 : 20 )  =  FLDVAL 
LTR  =  'A' 

CALL'  BTREE(LTR,TEN,A,MAXLEN,IREC,IERR) 

RETURN 

END 
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SUBROUTINE  T ABDEL ( FLD NAME , FLDVAL ,NUM) 

C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD.KEYFLD .CAT NAME ,RECDATA,A,NREF,L0NG(20)  , 

2  10(20) ,ANS,TYPE (20) ,FL0( 20) .TITLE (20) .WHERE (20) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  I  ERR , I NA ( 20 ) , I NB ( 20 ) ,EXA(20) ,EXB(20) , HOW (10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,1NB,EXA,EXB,I0,IERR,NREF 

CHARACTER  LTR*1,H0W*6,CATNAME*9,WHERE*9,TITLE*10 
CHARACTER  ANS*3 , A*20 , FLD*1 00 , RECDATA*256 
C 

CHARACTER  FLDNAME*10,FLDVAL*10 
C 

401  FORMAT (A3) 

410  FORMAT ( / '  REQUEST  DENIED  -  REFERENCED  BY  CATEGORY  ',A9) 

411  F0RMAT(/3X, 'PRESS  THE  "RETURN"  KEY  TO  CONTINUE') 

412  FORMAT (/3X , 'DO  YOU  WISH  TO  DELETE  THE  FIELD  VALUE  '  ,A10/ 

*3X , ' FROM  THE  FIELD  NAMED  ',A10,'?  (Y/N)') 

413  F0RMAT(/3X, ' DELETION  REQUEST  CANCELLED') 


DRIVER  FOR  DELETING  A  "TABLE"  FIELD  VALUE 


A ( 1 : 10 )  =  FLDNAME 
A ( 1 1 : 20 )  =  FLDVAL 
LTR  =  ' G  ' 

CALL  BTREE(LTR .TEN ,A .MAXLEN , KEYREC  ,  I  ERR) 
CHECK  FOR  RELATED  RECORDS 


LTR  =  ' F ' 

4005  CALL  BTREE(LTR,NINE,A,MAXLEN,IREC,IERR) 

IF  (IERR.EQ.4.0R.IERR.EQ.5)  GO  TO  4035 
LTR  =  'S' 

READ(19,H0W(9) ,REC=IREC)  RECDATA 
CATNAME  =  RECDATA( 1:9) 

NF I  ELD  =  VAL(RECDATA(20: 21 ) ) 

CLOSE ( UN  I T  =  20 ) 

0PEN(UNIT=20,F I LE=CATNAME / / ' .LAR' , STATUS= ' OLD ' , 

*  FORM=' FORMATTED' ,ACCESS='DIRECT') 

DO  4025  I =1 , NF I  ELD 

READ(20,H0W(10) ,REC  =  I )  RECDATA 
TITLE(I)  =  RECDATA( 1 : 10) 

TYPE (  I  )  =  VAL(RECDATA( 13:  14) ) 

IF  ( TITLE ( I ) .EQ. FLDNAME  .AND.TYPE( I)  .EQ.4)  THEN 
CALL  OPENCAT 
LTR  =  '  F  ' 
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4010  CALL  BTREE(LTR,ONE,A,MAXLEN,IREC,IERR) 

IF  (IERR.EQ.4.0R.IERR.EQ.5)  THEN 
DO  4020  N  =  1  ,NREF 
K  =  N  +  10 
CLOSE ( UN  I T  =  K ) 

4020  CONTINUE 

GO  TO  4025 
END  IF 

READ(11,H0W(1) ,REC=IREC)  RECDATA 
K  =  VAL(RECDATA(INA(I):  INB(I))) 

IF  (K.EQ.KEYREC)  THEN 
HR  I TE ( 22 , 4 10 )  CATNAME 
CALL  RECOUT 
CALL  SHOWREC 
WR ITE ( 22 , 41 1 ) 

READ (21,401)  ANS 
RETURN 
END  IF 
LTR  =  ' S  ‘ 

GO  TO  4010 
END  IF 

4025  CONTINUE 
LTR  =  'S' 

GO  TO  4005 

DELETE  A  "TABLE"  FIELD  VALUE 

4035  IF  (NUM.EQ.2)  THEN 

WRITE(22,412)  FLDVAL , FLDNAME 
READ ( 2 1 , 40 1 )  ANS 
IF  ( ANS ( 1 : 1 )  .EQ.' V  )  THEN 
GO  TO  4040 

ELSE  IF  ( ANS (1:1)  .EQ.'N' )  THEN 
WR  I TE ( 22 , 413  ) 

RETURN 

ELSE 

GO  TO  4035 
END  IF 
END  IF 

4040  LTR  =  'O' 

A ( 1 :  10  )  =  FLDNAME 
A  ( 1 1 : 20)  =  FLDVAL 

CALL  BTREE(LTR,TEN,A,MAXLEN,IREC,IERR) 

RETURN 

END 
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SUBROUTINE  TABL 1ST ( FLDNAME ,FLDVAL,IND) 

C 

IMPLICIT  INTEGERM  (A-Z) 

C 

COMMON  /XXXBOSS/ 

1  NFIELD,KEYFLD,CATNAME,RECDATA,A,NREF,L0NG(20), 

2  10(20) ,ANS, TYPE (20) ,FLD{ 20) , T I TLE ( 20 ) , WHERE ( 20  ) , 

3  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, 

4  IERR, INA(20) ,INB(20) ,EXA(20) ,EXB(20) ,H0W(10) ,LTR 
BYTE  ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN 
BYTE  INA,INB,EXA,EXB,IO,IERR,NREF 

CHARACTER  LTR *1 , H0W*6 , CATNAME*9 , WHER E*9 , T ITLE*10 
CHARACTER  ANS*3 , A*20 , FLO* 100 ,RECDATA*2 56 
C 

CHARACTER  FLDNAME*10 , FLD VAL *10  ,  TEMP ( 20  )  *  10 
LOGICALM  TYPO 
C 

201  FORMAT (A3) 

210  F0RMAT(/15X, 'FIELD  VALUES  FOR  '  ,A10// 

*10X, 'NUMBER' ,10X, 'FIELD  VALUE '/) 

211  F0RMAT(11X,I3,2X,A20) 

212  FORMAT ( / ) 

213  F0RMAT(3X, 'ENTER  THE  APPROPRIATE  NUMBER  OR’) 

214  F0RMAT(3X, 'ENTER  ZERO  TO  SEE  MORE  LIST') 

215  F0RMAT(3X, ' ENTER  THE  APPROPRIATE  NUMBER') 

216  F0RMAT(3X,  'ENTER  ZERO  IF  SATISFACTORY') 

217  F0RMAT(3X, 'ENTER  ZERO  TO  CONTINUE') 


LIST  ALL  "TABLE"  VALUES  FOR  A  GIVEN  FIELD 


WRITE(22,210)  FLDNAME 
KOUNT  =  0 
LTR  =  ' G ' 

A  =  FLDNAME 

2010  CALL  BTREE(LTR,TEN,A,MAXLEN,IREC,  IERR) 
LTR  =  'S' 

IF  (IERR. EQ. 4. OR. IERR. EQ. 5)  GO  TO  2020 
IF  ( A ( 1 : 10 ) .EQ. FLDNAME)  THEN 
KOUNT  =  KOUNT  +  1 
TEMP ( KOUNT )  =  A(ll:20) 

WR I TE ( 22 , 21 1 )  KOUNT, TEMP(KOUNT) 

IF  (M0D(K0UNT,20)  .NE.O)  GO  TO  2010 
2015  WRITE(22,212) 

IF  (IND.LE.2)  WR I TE ( 22 , 21 3  ) 

WR I TE ( 22 , 214  ) 

READ (21,201)  ANS 

CALL  CHECK(ANS,N, KOUNT, TYPO) 

IF  (TYPO)  GO  TO  2015 
IF  (N.EQ.O)  THEN 
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KOUNT  =  0 
60  TO  2010 
ELSE 

GO  TO  2030 
END  IF 
END  IF 
GO  TO  2010 
C 

2020  WRITE{22,212) 

IF  (IND.EQ.l)  THEN 
WRITE(22,213) 

WRITE (22, 216) 

ELSE  IF  (IND.EQ.2)  THEN 
WR I TE ( 22 , 21 5 ) 

ELSE  IF  (IND.EQ.3)  THEN 
WRITE(22,217) 

END  IF 

READ ( 2 1 , 20 1 )  ANS 
CALL  CHECK(ANS,N, KOUNT  .TYPO) 
IF  (TYPO)  GO  TO  2020 
IF  (N.EQ.O)  THEN 
FLDVAL  =  '  ' 

RETURN 
END  IF 
C 

2030  FLDVAL  =  TEMP ( N ) 

RETURN 

END 
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C 


C 


SUBROUTINE  CHECK ( ANS , N , NMAX , TYPO ) 

CHARACTER  ANS*3,B*1 
LOGICALM  TYPO 

401  FORMAT ( I <L> ) 

410  F0RMAT(/3X, ' KEYSTROKE  ERROR  -  TRY  AGAIN') 


TRAP  FOR  A  PARTICULAR  CLASS  OF  TYPOGRAPHICAL  ERRORS 


TYPO  =  .FALSE. 

DO  4010  L *3 , 1 , - 1 

IF  ( ANS ( L : L  )  .NE.'  ' )  GO  TO  4020 
4010  CONTINUE 

TYPO  =  .TRUE. 

GO  TO  4040 
4020  DO  4030  K=1,L 

B  =  ANS ( K : K ) 

IF  ( ICHAR(B) .LT.48.0R. I  CHAR ( B )  .GT  .  57 )  TYPO  =  .TRUE. 
4030  CONTINUE 

IF  (TYPO)  GO  TO  4040 
DEC0DE(L,401,ANS)  N 
IF  (N.GT.NMAX)  TYPO  =  .TRUE. 

4040  IF  (TYPO)  WRITE(22,410) 

RETURN 

END 
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FUNCTION  ENDATE(WHEN) 

C 

IMPLICIT  INTEGERM  (A-Z) 

C 

I NT£GER*2  MCDF(12) 

CHARACTER  MM*2,DD*2,YYYY*4,WHEN*10 
C 

DATA  MCDF/ 0,31, 59, 90, 120, 15 1,18 1,21 2, 243, 27 3, 304, 334/ 
701  F  ORMAT ( I <L> ) 


CONVERT  THE  OATE  GIVEN  BY  'WHEN'  INTO  THE 
NUMBER  OF  DAYS  SINCE  DECEMBER  31,1899 


I  =  INDEX (WHEN  ,  1 /  '  ) 

L  =  2 

IF  (I.EQ.2)  L  =  1 
DEC0DE(L,701,WHEN(1:I-1))  MONTH 
J  =  INDEX(WHEN(I  +  1 : 10)  ,  ' / ' )  +  I 
K  =  J  -  I 
L  =  2 

IF  (K.EQ.2)  L  =  1 

DECODE (L  ,  701  ,WHEN(  1  +  1 : J-l ) )  DOM 

L  =  4 

DEC0DE(L,701,WHEN(J+l:J+4))  YEAR 

DIFF  =  YEAR  -  1900 
MANY  =  D I FF*365 

MANY  =  MANY  +  DIFF/4  -  DIFF/100  +  ( D I FF+300 ) / 400 
IF  (MONTH. GT. 2)  THEN 
UNLEAP  =  0 

ELSE  IF  (M0D(YEAR,400)  .EQ.Q)  THEN 
UNLEAP  =  1 

ELSE  IF  (MOD(YEAR.IOO)  .EQ.O)  THEN 
UNLEAP  =  0 

ELSE  IF  (M0D(YEAR,4)  .EQ.O)  THEN 
UNLEAP  =  1 
ELSE 

UNLEAP  =  0 
END  IF 

ENOATE  =  MANY  +  MCDF ( MONTH )  +  DOM  -  UNLEAP 

RETURN 

END 
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FUNCTION  DEDATE ( MANY ) 

C 

IMPLICIT  INTEGERM  (A-Z) 

C 

I NT£G£R*2  MCDF ( 1 2 ) 

CHARACTER  MM*2 , DD*2 , YYY Y*4  , DEDATE *10 
C 

DATA  MCDF /O, 31 ,59,90,120,151,181 .212,243,273,304,334/ 
801  FORMAT ( I  <L> ) 


CONVERT  NUMBER  OF  DAYS  SINCE  DECEMBER  31,1899 
INTO  MONTH/DAY/YEAR 


YEAR  =  1900 

8010  IF  (M0D(YEAR,400)  .EQ.O)  THEN 
LEAP  =  1 

ELSE  IF  (MOD(YEAR, 100)  .EQ.O)  THEN 
LEAP  =  0 

ELSE  IF  (M0D(YEAR,4) .EQ.O)  THEN 
LEAP  =  1 
ELSE 

LEAP  =  0 
END  IF 

DO  WHILE  (MANY.GT.365+LEAP) 

MANY  =  MANY  -  (365  +  LEAP) 

YEAR  =  YEAR  +  1 
GO  TO  8010 
END  DO 
J  =  12 

DO  WHILE  (MANY  ,LE  .MCDF ( J  )  ) 

J  =  J  -  1 
END  DO 
MONTH  =  J 

DOM  =  MANY  -  MCDF(J) 

IF  (DOM. EQ.O)  THEN 
J  =  J  -  1 
MONTH  =  J 

DOM  =  MCDF ( J+l )  -  MCDF(J) 

END  IF 

IF  (MONTH. GT. 2. AND. LEAP. EQ.l)  THEN 
DOM  =  DOM  -  1 
IF  (DOM. EQ.O)  THEN 
J  =  J  -  1 
MONTH  =  J 

IF  (MONTH. EQ. 2)  THEN 
DOM  =  29 
ELSE 

DOM  =  MCDF ( J+l )  -  MCDF(J) 
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END  IF 
END  IF 
END  IF 

L  =  2 

IF  ( MONTH/ 10  .EQ  .0  )  L  =  1 
ENCODE (L ,801 ,MM)  MONTH 
MML  =  L 
L  =  2 

IF  (DOM/10. EQ.O)  L  =  1 
E  NCODE ( L , 80 1 ,  DD  )  DOM 
DDL  =  L 
L  =  4 

ENCODE ( L , 80 1 , YY Y  Y  )  YEAR 

DEDATE  =  MM (1: MML)// ' / ' / / DD ( 1 : DDL ) / / * / ' / / Y  Y  Y  Y 

RETURN 

END 
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FUNCTION  CONVERT (A ) 
CHARACTER  A*15 


501  FORMAT ( I <L>  ) 


CONVERT  A  NUMBER  IN  STRING  FORMAT  INTO  ITS  REAL  VALUE 


FRAC  =  0. 

N  =  INDEX( A,  '  '  ) 

IF  (N.EQ.O)  THEN 
N  =  LEN(A) 

ELSE 

N  =  N  -  1 
END  IF 

INTEGER  PORTION 

K  =  I NDEX ( A( 1 : N  )  .'  ) 

IF  (K.EQ.O)  THEN 
L  =  N 

DECODE ( L , 50 1  ,  A  )  M 
X  =  M 

ELSE  IF  (K.EQ.l)  THEN 
X  =  0. 

ELSE 

L  =  K  -  1 

DEt0DE(L,501,A(l:L))  M 
X  =  M 
END  IF 

IF  (K.EQ.O.OR.K.EQ.N)  GO  TO  5020 

FRACTIONAL  PORTION 

KP1  =  K  t  1 
DO  5010  J  =  KP1 ,  N 

Y  =  I  CHAR ( A( J : J ) )  -  48 
FRAC  =  FRAC  +  Y/10**(J-K) 

010  CONTINUE 

020  IF  (A( 1 : 1)  .EQ.  )  THEN 
X  =  M  -  FRAC 
ELSE 

X  =  M  +  FRAC 
END  IF 
CONVERT  =  X 
RETURN 
END 
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